home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Your Choice 1
/
your choice.zip
/
your choice
/
PRGMMING
/
VISIONIX
/
VCRTU.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-12-30
|
161KB
|
8,327 lines
{
════════════════════════════════════════════════════════════════════════════
Visionix CRT API to VOut/VIn Unit (VCRT)
Version 0.13
Copyright 1991,92,93 Visionix
ALL RIGHTS RESERVED
────────────────────────────────────────────────────────────────────────────
Revision history in reverse chronological order:
Initials Date Comment
──────── ──────── ────────────────────────────────────────────────────────
jrt 12/28/93 Added TextColors, GotoX, GotoY
jrt 12/05/93 Modified to reflect changes to VOUTu wherein
VOutSubChanNew and VOutFilterAttach now have
three driver parameters instead of one.
jrt 11/28/93 Added MakeAttr function.
jrt 11/10/93 Finished RegionFillXXX functions.
jrt 11/10/93 Added CRTOutDriverProc cases for ODF_Regionxxx
jrt 07/10/93 Converted to use start of new VOUT chan/subchan/filter
architecture.
rag 05/18/93 Added FillRegionAttr.
jrt 05/16/93 Changed carriage return/line feed values because
mike and rob said they were wrong.
IT WAS MY FAULT. Sincerely, Jon
mep 03/26/93 Added usage of VBios.
lpg 03/15/93 Added Source Documentation
mep 02/11/93 Cleaned up code for beta release
jrt 02/08/93 Sync with beta 0.12 release
jrt 02/08/93 Added support to automatically determine the
screen size by supporting the new VOutGetScreenSize
function.
jrt 12/07/92 Sync with beta 0.11 release
jrt 12/07/92 Fixed bug in TextBackGround that would allow
"high-intensity" background colors to be set,
which in fact would just set the blink attribute on.
Only bits 0-1-2 of background color are valid now.
jrt 12/01/92 Yanked VGACharWidthSet, moved it into VFont.
jrt 12/01/92 Yanked console info functions, moved them to
Vequip. Was this a good decision? Who knows.
jrt 11/21/92 Sync with beta 0.08
jrt 10/26/92 Fixed two bugs: one fixed "mangling" of the attr
setting be making textattr := knowntextattr in the
syncattr routine. The other fixed the improper
scrolling of windows when a writeln occured at the
bottom of the window.
jrt 09/01/92 First logged revision.
--------------------------------------------------------------------------
Notes:
yank VGAcharwidthset, it is now in VFont.
yank console info obtaining functions, they are now in VEquip.
As a result, figure out what to do with VCRTGetCaps.
════════════════════════════════════════════════════════════════════════════
}
(*-
[SECTION: Section 2: The Text I/O Libraries]
[CHAPTER: Chapter 2: The CRT API replacement unit]
[TEXT]
<Overview>
VCRTu is a Turbo Pascal CRT replacement unit. It implements all
of the functions found in the TP CRT unit, and adds many new functions.
VCRTu is an interface layer on top of VOUTu and VINu. Calls to
VCRTu functions are completed by calling the appropriate VOUTu or
VINu function.
VCRTu automatically creates a CRT output channel and a sub-channel
which sends its output to the primary local video display.
<<Whats all that mean>>
Basically, VCRTu replaces CRT. VCRTu does all of its work through
a fast, flexible, and comprehensive text input and output architecture
which is based on the concept of text input and output channels
and sub-channels. By default, VCRTu automatically creates a
text output channel and sub-channel which goes to the primary
video display, and a text input channel and sub-channel which goes
to the keyboard. VCRT then does all of its work via these channels.
For example, when you call ClrScr, VCRT calls VOutClrScr with the
handle of the CRT output channel. When you call ReadKey, VCRT
calls VInReadKey with the handle of the CRT input channel.
By attaching filters to the CRT sub-channel you can enhance or modify
the output capabilities of your application. For example, you
can attach the AnsiFilter to the CRT sub-channel to make it possible
to use ANSI commands in your Write or WriteLn statements.
By creating new sub-channels off of the CRT channel, you can direct
the output of your program to other devices, such as the serial port.
This creates a flexable foundation for BBS programs or DOOR programs.
For more information, see the VOUTu and VINu chapters.
<Interface>
-*)
Unit VCRTu;
Interface
Uses
VTypesu,
VInu,
VOutu,
{$IFNDEF OS2}
VBiosu,
{$ELSE}
VVioI,
{$ENDIF}
{$IFDEF DEBUG}
VDEBUGU,
{$ENDIF}
DOS;
{────────────────────────────────────────────────────────────────────────────}
Const
{-------------}
{ Video Modes }
{-------------}
BW40 = 0;
CO40 = 1;
C40 = CO40;
BW80 = 2;
CO80 = 3;
C80 = CO80;
Mono = 7;
Font8x8 = 256;
{--------}
{ Colors }
{--------}
Black = 0;
Blue = 1;
Green = 2;
Cyan = 3;
Red = 4;
Magenta = 5;
Brown = 6;
LightGray = 7;
DarkGray = 8;
LightBlue = 9;
LightGreen = 10;
LightCyan = 11;
LightRed = 12;
LightMagenta = 13;
Yellow = 14;
White = 15;
Blink = 128;
BackBlack = 0 SHL 4;
BackBlue = 1 SHL 4;
BackGreen = 2 SHL 4;
BackCyan = 3 SHL 4;
BackRed = 4 SHL 4;
BackMagenta = 5 SHL 4;
BackBrown = 6 SHL 4;
BackLightGray = 7 SHL 4;
{--------------------------------------------------------}
{ Card & monitor types for CRT Capabilities (CrtGetCaps) }
{--------------------------------------------------------}
cCardNone = $00;
cCardVGA = $01;
cCardEGA = $02;
cCardMDA = $03;
cCardHGC = $04;
cCardCGA = $05;
cMonitorNone = $00;
cMonitorMono = $01;
cMonitorColor = $02;
cMonitorEGAHiRes = $03;
cMonitorAnaMono = $04;
cMonitorAnaColor = $05;
{--------------------------------------------}
{ Color attribute to monochrome atribute map }
{--------------------------------------------}
MonoMap : Array[0..255] of BYTE = (
{00} $00, $01, $07, $07, $07, $07, $07, $07,
$07, $07, $07, $07, $07, $07, $0F, $0F,
{10} $70, $01, $07, $07, $07, $07, $07, $07,
$07, $07, $07, $07, $07, $07, $0F, $0F,
{20} $70, $70, $70, $70, $70, $70, $70, $70,
$70, $70, $70, $70, $70, $70, $70, $70,
{30} $70, $70, $70, $70, $70, $70, $70, $70,
$70, $70, $70, $70, $70, $70, $70, $70,
{40} $70, $70, $70, $70, $70, $70, $70, $70,
$70, $70, $70, $70, $70, $70, $70, $70,
{50} $70, $70, $70, $70, $70, $70, $70, $70,
$70, $70, $70, $70, $70, $70, $70, $70,
{60} $70, $70, $70, $70, $70, $70, $70, $70,
$70, $70, $70, $70, $70, $70, $70, $70,
{70} $70, $70, $70, $70, $70, $70, $70, $70,
$70, $70, $70, $70, $70, $70, $70, $70,
{80} $80, $81, $87, $87, $87, $87, $87, $87,
$87, $87, $87, $87, $87, $87, $8F, $8F,
{90} $F0, $81, $87, $87, $87, $87, $87, $87,
$87, $87, $87, $87, $87, $87, $8F, $8F,
{A0} $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
$F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
{B0} $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
$F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
{C0} $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
$F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
{D0} $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
$F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
{E0} $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
$F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
{F0} $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
$F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0 );
Type
{------------------------}
{ CRT System Information }
{------------------------}
TCRTSystem = RECORD
Card : BYTE;
Monitor : BYTE;
END;
PCRTSystem = ^TCRTSystem;
{----}
{----------------------------------------}
{ CRT Capabilities & Info for CrtGetCaps }
{----------------------------------------}
TCRTCaps = RECORD
actdisplay : byte;
altdisplay : byte;
CRTSystem : Array[1..2] of TCRTSystem;
CurMode : BYTE;
END;
PCRTCaps = ^TCRTCaps;
TCRTColorMap = Array[0..255] of BYTE;
PCrtColorMap = ^TCRTColorMap;
{────────────────────────────────────────────────────────────────────────────}
Procedure CRTGetCaps( Caps : PCRTCaps );
Function CRTIsVGA : BOOLEAN;
Function CRTIsMono : BOOLEAN;
Procedure CRTVGASetCharWidth( CWid : BYTE );
Procedure CRTOutDriverProc( ODP : POutDriverPacket );
{$IFDEF OS2}
Procedure VIOOutDriverProc( ODP : POutDriverPacket );
{$ENDIF}
Procedure CRTInDriverProc( IDP : PInDriverPacket );
Procedure CRTLoadColorMap( P : PCRTColorMap );
Procedure CRTLoadMonoColorMap;
Procedure CRTLoadDefColorMap;
Procedure AssignCRT( Var F : TEXT );
Procedure ClrEOL;
Procedure ClrScr;
Procedure Delay( MS : WORD );
Procedure DelLine;
Procedure GotoXY( X : BYTE;
Y : BYTE );
Procedure HighVideo;
Procedure InsLine;
Function KeyPressed : BOOLEAN;
Procedure LowVideo;
Procedure NormVideo;
Procedure NoSound;
Function ReadKey : CHAR;
Procedure Sound( HZ : WORD );
Procedure TextBackGround( Color : BYTE );
Procedure TextColor( Color : BYTE );
Procedure TextMode( Mode : INTEGER );
Function WhereX : BYTE;
Function WhereY : BYTE;
Procedure Window( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE );
{---------------------}
{ VCRT Sync Functions }
{---------------------}
Procedure SyncAttr;
Procedure SyncWind;
{-------------------------}
{ VCRT Enhanced functions }
{-------------------------}
Procedure WindowScreen;
{ Change text attribute }
Function TextColorGet : BYTE;
Function TextBackgroundGet : BYTE;
Procedure TextColors( Fore : BYTE;
Back : BYTE );
Procedure TextAttrSet( Attr : BYTE );
{ cursor movement commands }
Procedure CursorUp( Count : BYTE );
Procedure CursorDown( Count : BYTE );
Procedure CursorLeft( Count : BYTE );
Procedure CursorRight( Count : BYTE );
{ screen store read functions }
Function CharRead( X1 : BYTE;
Y1 : BYTE ) : CHAR;
Function AttrRead( X1 : BYTE;
Y1 : BYTE ) : BYTE;
Procedure AttrWrite( X1 : BYTE;
Y1 : BYTE;
Attr : BYTE );
{ Region Functions }
Function RegionMemQuery( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE ) : WORD;
Procedure RegionScrollUp( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Count : BYTE );
Procedure RegionScrollDown( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Count : BYTE );
Procedure RegionRead( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Region : Pointer );
Procedure RegionWrite( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Region : Pointer );
Procedure RegionCopy( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
ToX1 : BYTE;
ToY1 : BYTE );
Procedure RegionFill( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Ch : CHAR;
F : BYTE;
B : BYTE );
Procedure RegionFillAttr( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Attr : BYTE );
Procedure RegionFillColors( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
F : BYTE;
B : BYTE );
Procedure RegionFillChar( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Ch : CHAR );
{ RegionFillString??? }
Procedure RepeatChar( Ch : CHAR;
Num : WORD );
Procedure RepeatCharAt( X1 : BYTE;
Y1 : BYTE;
F : BYTE;
B : BYTE;
Ch : CHAR;
Num : WORD );
Procedure WriteCharAt( X1 : BYTE;
Y1 : BYTE;
F : BYTE;
B : BYTE;
Ch : CHAR );
Procedure WriteStringAt( X1 : BYTE;
Y1 : BYTE;
F : BYTE;
B : BYTE;
S : STRING );
Procedure WriteRepeatString( RepCount : WORD;
S : STRING );
{ cursor control }
Procedure CursorOn;
Procedure CursorOff;
Procedure CursorSmall;
Procedure CursorHalf;
Procedure CursorBig;
{ misc }
Function MakeAttr( F : INTEGER;
B : INTEGER ) : BYTE;
Var
CheckBreak : BOOLEAN; { standard CRT variables ... }
CheckEOF : BOOLEAN;
DirectVideo : BOOLEAN;
CheckSnow : BOOLEAN;
LastMode : WORD;
TextAttr : BYTE;
Font8x8Selected : BOOLEAN;
WindMin : WORD;
WindMax : WORD;
WindCenterCol : BYTE; { center column on the primary display }
WindCenterRow : BYTE; { center row on the primary display }
ScreenRows : BYTE; { number of rows on the primary display }
ScreenCols : BYTE; { number of cols on the primary display }
KnownTextAttr : BYTE; { used to do SYNC operations }
KnownWindMin : WORD; { used to do SYNC operations }
KnownWindMax : WORD; { used to do SYNC oeprations }
CrtODNErr : WORD; { used by vin/vout }
CrtOCH : TChanHandle; { Handle VCRu uses with VOUTu }
CrtColorMap : Array[0..255] of BYTE; { active TEXTATTR color map }
TF : TEXT; { for debug log file testing }
{────────────────────────────────────────────────────────────────────────────}
Implementation
{
Uses
VAnsiIOu;
}
Const
DelayOfMS : Word = 0;
{--------------------------------------------}
{ Types and functions used when in OS/2 mode }
{--------------------------------------------}
{$IFDEF OS2}
Type
TKbdKeyInfo = RECORD
chChar : Char;
chScan : Char;
fbStatus : Byte;
bNlsShift : Byte;
fsState : Word;
time : LongInt;
End;
PKbdKeyInfo = ^TKbdKeyInfo;
Function KbdCharIn( Var KeyInfo : TKbdKeyInfo;
Wait : Word;
KbdHandle : Word ) : Word; Far;
External 'KBDCALLS' Index 4;
Function KbdPeek( Var KeyInfo : TKbdKeyInfo;
KbdHandle : WORD ) : WORD; Far;
External 'KBDCALLS' Index 22;
Function DosSleep( Time : LONGINT ) : WORD; Far;
External 'DOSCALLS' Index 32;
{$ENDIF}
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CRTGetCardAndMonInfo( C : PCRTCaps );
[PARAMETERS]
C Pointer to Video Capacity Structure
[RETURNS]
(Function : None)
(Ptr : [C] Pointer to Video Capacity Structure)
[DESCRIPTION]
This function fills in the CRT capabilities structure pointed to by
"C" with information about the current CRT systems.
This function is mainly for internal use. The CrtGetCaps function
should be used in place of this one.
[SEE-ALSO]
CrtGetCaps
[EXAMPLE]
-*)
Procedure CRTGetCardAndMonInfo( C : PCRTCaps );
Var
ShouldCheckVGA : BOOLEAN;
ShouldCheckEGA : BOOLEAN;
ShouldCheckMono : BOOLEAN;
ShouldCheckCGA : BOOLEAN;
{$IFNDEF OS2}
R : REGISTERS;
{$ENDIF}
{────────────────────────────────────────────────────────────────────────}
{$IFNDEF OS2}
Function CheckFor6845( Port : WORD ) : BOOLEAN;
Var
Test : BYTE;
BEGIN
{-------------------}
{ CheckFor6845 !^! }
{-------------------}
ASM
MOV DX, PORT
MOV AL, $0A
OUT DX, AL
INC DX
IN AL, DX
MOV AH, AL
CMP AH, 4
JE @@1
MOV AL, 4
JMP @@2
@@1:
MOV AL, 3
@@2:
OUT DX, AL
MOV CX, 100
@@3:
LOOP @@3
IN AL, DX
XCHG AL, AH
OUT DX, AL
MOV TEST, 1
CMP AL, AH
JNE @@4
MOV TEST, 0
@@4:
END; { Asm }
CheckFor6845 := (Test=1);
END; { CheckFor6845 }
{────────────────────────────────────────────────────────────────────────}
Procedure CheckVGA;
Const
ConvertCard : Array[0..8] of BYTE = ( cCardNone,
cCardMDA,
cCardCGA,
cCardNone,
cCardEGA,
cCardEGA,
cCardNone,
cCardVGA,
cCardVGA );
ConvertMon : Array[0..8] of BYTE = ( cMonitorNone,
cMonitorMono,
cMonitorColor,
cMonitorNone,
cMonitorEGAHiRes,
cMonitorMono,
cMonitorNone,
cMonitorAnaMono,
cMonitorAnaColor );
BEGIN
R.ES := 0;
R.DS := 0;
R.AX := $1A00;
Intr( $10, R );
If R.AL = $1A Then
BEGIN
C^.CRTSystem[1].Card := ConvertCard[ R.BL ];
C^.CRTSystem[1].Monitor := ConvertMon[ R.BL ];
C^.CRTSystem[2].Card := ConvertCard[ R.BH ];
C^.CRTSystem[2].Monitor := ConvertMon[ R.BH ];
ShouldCheckCGA := FALSE;
ShouldCheckEGA := FALSE;
If C^.CRTSystem[1].Card = cCardMDA Then
BEGIN
C^.CRTSystem[1].Card := cCardNone
END { If C^.CRTSystem[1].Card }
Else
If C^.CRTSystem[2].Card = cCardMDA Then
BEGIN
C^.CRTSystem[2].Card := cCardNone
END { If C^.CRTSystem[2].Card }
Else
BEGIN
If C^.CRTSystem[2].Card <> cCardNone Then
ShouldCheckMono := FALSE;
END; { If C^.CRTSystem[2].Card / Else }
END; { If R.AL }
END; { CheckVGA }
{────────────────────────────────────────────────────────────────────────}
Procedure FoundCRTSystem( Card, Monitor : BYTE );
BEGIN
IF C^.CRTSystem[1].Card = cCardNone Then
BEGIN
C^.CRTSystem[1].Card := Card;
C^.CRTSystem[1].Monitor := Monitor;
END { If C^.CRTSystem[1].Card }
ELSE
BEGIN
C^.CRTSystem[2].Card := Card;
C^.CRTSystem[2].Monitor := Monitor;
END; { If C^.CRTSystem[1].Card / Else }
END; { FoundCRTSystem }
{────────────────────────────────────────────────────────────────────────}
Procedure CheckEGA;
Var
MonType : BYTE;
Const
ConvertDips : Array[0..5] of BYTE = ( cMonitorColor,
cMonitorEGAHiRes,
cMonitorMono,
cMonitorColor,
cMonitorEGAHiRes,
cMonitorMono );
BEGIN
R.AH := $12;
R.BL := $10;
R.ES := $0;
R.DS := $0;
Intr( $10, R );
If R.BL <> $10 Then
BEGIN
ShouldCheckCGA := FALSE;
MonType := ConvertDips[ ((R.CL SHR 1) AND $0F) ];
FoundCRTSystem( cCardEGA, MonType );
If MonType = cMonitorMono Then
ShouldCheckMono := FALSE;
END; { if R.BL }
END; { CheckEGA }
{────────────────────────────────────────────────────────────────────────}
Procedure CheckCGA;
BEGIN
If CheckFor6845( $3D4 ) Then
BEGIN
FoundCRTSystem( cCardCGA, cMonitorColor );
END; { CheckFor6845 }
END; { CheckCGA }
{────────────────────────────────────────────────────────────────────────}
Procedure CheckMono;
Var
CardType : BYTE;
BEGIN
{ Check Mono }
If CheckFor6845( $3B4 ) Then
BEGIN
{ Found Mono-6845 }
ASM
MOV DX, $3BA
IN AL, DX
AND AL, $80
MOV AH, AL
MOV CX, $8000
@@1:
IN AL, DX
AND AL, $80
CMP AL, AH
JNE @@2
LOOP @@1
MOV CardType, cCardMDA
JMP @@3
@@2:
MOV CardType, cCardHGC
@@3:
END; { Asm }
FoundCRTSystem( CardType, cMonitorMono );
END; { If CheckFor6845 }
END; { CheckMono }
{────────────────────────────────────────────────────────────────────────}
Procedure SwapCRTSystems;
Var
Temp : TCRTSystem;
BEGIN
Temp := C^.CRTSystem[1];
C^.CRTSystem[1] := C^.CRTSystem[2];
C^.CRTSystem[2] := Temp;
END; { SwapCRTSystems }
{────────────────────────────────────────────────────────────────────────}
{$ENDIF} { os/2 }
BEGIN { Procedure CRTGetCardAndMonInfo }
{$IFDEF OS2}
C^.CurMode := 3;
C^.CrtSystem[1].Card := cCardVGA;
C^.CrtSystem[1].Monitor := cMonitorAnaColor;
C^.CrtSystem[2].Card := CCardNone;
{$ELSE}
ShouldCheckVga := TRUE;
ShouldCheckEGA := TRUE;
ShouldCheckMono := TRUE;
ShouldCheckCGA := TRUE;
C^.CRTSystem[1].Card := cCardNone;
C^.CRTSystem[1].Monitor := cMonitorNone;
C^.CRTSystem[2].Card := cCardNone;
C^.CRTSystem[2].Monitor := cMonitorNone;
If ShouldCheckVGA Then
CheckVGA;
If ShouldCheckEGA Then
CheckEGA;
If ShouldCheckCGA Then
CheckCGA;
If ShouldCheckMono Then
CheckMono;
If (C^.CRTSystem[1].Card<>cCardVGA) and
(C^.CRTSystem[2].Card<>cCardVGA) Then
BEGIN
R.AH := $0F;
R.ES := $0;
R.DS := $0;
Intr( $10, R );
If R.AL = $07 Then
BEGIN
If (C^.CRTSystem[1].Monitor<>cMonitorMono) Then
SwapCRTSystems;
END { If R.AL }
ELSE
BEGIN
If (C^.CRTSystem[1].Monitor=cMonitorMono) Then
SwapCRTSystems;
END; { If R.AL / Else }
END; { If C^.CRTSystem[1].Card } { IF No VGA }
R.AH := $0F;
R.ES := $0;
R.DS := $0;
Intr( $10, R );
C^.CurMode := R.AL;
{$ENDIF} { os/2 }
END; { CRTGetCardAndMonInfo }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CRTGetCaps( Caps : PCRTCaps );
[PARAMETERS]
Caps Pointer to Video Capacity Structure
[RETURNS]
(Function : None)
(Ptr : [C] Pointer to CRT Capabilities Structure)
[DESCRIPTION]
This function fills in the CRT capabilities structure pointed to by
"Caps" with information about the current CRT systems. A CRT system
is a video card and monitor combination. The PC can have two
CRT systems installed--a primary and an alternate. Typically,
the primary is either cga/ega/vga/hercules/mono, and the alternate, if
present, is hercules/mono.
<CRT Capabilities Structure>
TCRTCaps = RECORD
actdisplay : byte;
altdisplay : byte;
CRTSystem : Array[1..2] of TCRTSystem;
CurMode : BYTE;
END;
actdisplay is no longer used
altdisplay is no longer used
CRTSystem[1].Card = disply card for the primary CRT system
CRTSystem[1].Monitor = monitor for the primary CRT system
CRTSystem[2].Card = disply card for the secondary CRT system
CRTSystem[2].Monitor = monitor for the secondary CRT system
CurMode = video mode the primary CRT system is
currently in.
<<Card Types>>
cCardNone = $00;
cCardVGA = $01;
cCardEGA = $02;
cCardMDA = $03;
cCardHGC = $04;
cCardCGA = $05;
<<Monitor types>>
cMonitorNone = $00;
cMonitorMono = $01;
cMonitorColor = $02;
cMonitorEGAHiRes = $03;
cMonitorAnaMono = $04;
cMonitorAnaColor = $05;
[SEE-ALSO]
[EXAMPLE]
Var
CC : TCrtCaps;
BEGIN
CRTGetCaps( @CC );
If CC.CRTSystem[2].Card=cCardNone Then
WriteLn('An alternate CRT system is present.')
Else
WriteLn('No alternate CRT system is present.');
END;
-*)
Procedure CRTGetCaps( Caps : PCRTCaps );
BEGIN
{------------------------}
{ Get current video mode }
{------------------------}
{---------------------------}
{ Get primary and alternate }
{ display types }
{---------------------------}
CRTGetCardAndMonInfo( Caps );
END; { CRTGetCaps }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function CRTIsVGA : BOOLEAN;
[PARAMETERS]
(None)
[RETURNS]
Whether the primary CRT system is VGA.
[DESCRIPTION]
Checks to see if the primary CRT system is VGA.
Returns TRUE if the primary CRT system is a VGA display.
Returns FALSE if the primary is anything other than VGA.
[SEE-ALSO]
CrtIsMono
CrtGetCaps
[EXAMPLE]
If CrtIsVga Then
WriteLn(' The primary CRT is VGA.')
Else
WriteLn(' The primary CRT is non-VGA.');
-*)
Function CRTIsVGA : BOOLEAN;
Var
Caps : TCRTCaps;
BEGIN
CRTGetCaps(@Caps);
CRTIsVGA := Caps.CRTSystem[1].Card = cCardVGA;
(*
CRTIsVga := (Caps.ActDisplay In[ $07..$08 ]) AND (Caps.CurMode<>7);
*)
END; { CRTIsVGA }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function CRTIsMono : BOOLEAN;
[PARAMETERS]
(None)
[RETURNS]
Whether the primary CRT system is monochrome/hercules monochrome.
[DESCRIPTION]
Returns TRUE if the primary CRT system is a monochrome display.
Returns FALSE if the primary is anything other than monochrome.
[SEE-ALSO]
CrtIsVga
CrtGetCaps
[EXAMPLE]
If CrtIsMono Then
WriteLn(' The primary CRT is moncohrome/hercules monochrome.')
Else
WriteLn(' The primary CRT is not monochrome/hercules.');
-*)
Function CRTIsMono : BOOLEAN;
Var
Caps : TCRTCaps;
BEGIN
CRTGetCaps(@Caps);
CRTIsMono := (Caps.ActDisplay In[ $01..$01 ]) or (Caps.CurMode=7);
END; { CRTIsMono }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CRTOutDriverProc( ODP : POutDriverPacket );
[PARAMETERS]
ODP Pointer to Output Driver Packet
[RETURNS]
(None)
[DESCRIPTION]
This function is used internally by VCRTu and VOUTu.
This is a CRT output driver procedure that is used by VOUTu.
This function receives request from VOUTu to perform text output
operations, and performs the request on the current primary video
card.
All TP CRT API functions in VCRTu (I.E: GotoXY, Write, ClrScr, Etc)
are performed by calling the appropriate function in VOUTu.
It should not be necessary for anyone other than VCRTu and VOUTu
to call or use this function.
See VOUTu for more information.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CRTOutDriverProc( ODP : POutDriverPacket );
Type
TCharBuff = Array[1..32768] of CHAR;
PCharBuff = ^TCharBuff;
{----}
TCell = Record
Char : CHAR;
Attr : BYTE;
END; { TCell }
{----}
TScreenStore = Array[0..32000] of TCell;
PScreenStore = ^TScreenStore;
{----}
TScreen = RECORD
CurX : WORD;
CurY : WORD;
CurAttr : BYTE;
WinX1 : WORD;
WinX2 : WORD;
WinY1 : WORD;
WinY2 : WORD;
CurType : WORD;
ScreenSize: WORD;
S : PScreenStore;
END; { TScreen }
PScreen = ^TScreen;
{----}
TCRTOutDriverIData = Record
Off : WORD;
Name : TProcName;
VirtualCRT : BOOLEAN;
DisplayMode: BYTE;
Cols : WORD;
Rows : WORD;
YMult : WORD;
NumScreens : BYTE;
AScreen : BYTE;
Screen : Array[1..8] of TScreen;
MyODP : TOutDriverPacket;
END; { TCRTOutDriverIData }
PCRTOutDriverIData = ^TCRTOutDriverIData;
{----}
TVCRTDriverInfo = RECORD
Cols : WORD;
Rows : WORD;
Screens : WORD;
END; { TVCRTDriverInfo }
PVCRTDriverInfo = ^TVCRTDriverInfo;
MyPByte = ^Byte;
MyPWord = ^Word;
Var
IData : PCRTOutDriverIData;
YMult : WORD;
AS : PScreen;
Z : INTEGER;
Z2 : INTEGER;
Z3 : INTEGER;
SaveCurX : WORD;
SaveCurY : WORD;
CallNext : BOOLEAN;
{────────────────────────────────────────────────────────────────────────}
Procedure InitCRTIdata;
Type
MyPtrWord = ^WORD;
Var
{$IFNDEF OS2}
R : REGISTERS;
{$ENDIF}
Z : INTEGER;
StoreOfs : WORD;
BEGIN
{$IFDEF OS2}
{---------------------------------------}
{ Determine CRT type; mono, hercules-1, }
{ hercules-2, hercules in-color, cga, }
{ ega, or vga }
{---------------------------------------}
IData^.DisplayMode := 0;
{----------------------}
{ Determine CRT mode, }
{ active screen/page, }
{ and number of cols }
{----------------------}
IData^.DisplayMode := 3;
IData^.AScreen := 1;
IData^.Cols := 80;
IData^.YMult := IData^.Cols;
{---------------------}
{ Determine # of rows }
{---------------------}
IData^.Rows := 25;
If Idata^.Rows<25 Then
Idata^.Rows := 25;
{------------------------------}
{ Determine # of screens/pages }
{------------------------------}
IData^.NumScreens := 1;
{------------------------------}
{ Determine if Font8x8 is used }
{------------------------------}
{ If Vga and rows=50 then yes }
{ If Ega and rows=43 then yes }
{--------------------------------------------------}
{ Check for DV, Win, OS/2, Topview, Doubledos, etc }
{--------------------------------------------------}
{ look it up }
{-----------------------}
{ Get information }
{ For each display page }
{-----------------------}
For Z:= 1 to IData^.NumScreens Do
BEGIN
{--------------------}
{ Get cursor X and Y }
{--------------------}
IData^.Screen[Z].CurX := 1;
IData^.Screen[Z].CurY := 1;
{-----------------}
{ Get cursor type }
{-----------------}
{ set it and sync the crt }
{-----------------------}
{ Get Current Attribute }
{-----------------------}
IData^.Screen[Z].CurAttr := 7;
{--------------------}
{ Init window coords }
{--------------------}
{ call visionix services to determine window coords }
IData^.Screen[Z].WinX1 := 0;
IData^.Screen[Z].WinY1 := 0;
IData^.Screen[Z].WinX2 := IData^.Cols-1;
IData^.Screen[Z].WinY2 := IData^.Rows-1;
{----------------------------}
{ Get Pointer to screen/page }
{----------------------------}
IData^.Screen[Z].S := NIL;
{ we can't get the pointers to each page }
{ until we switch to the page. we can, }
{ however, get the pointer to the active }
{ page, which we will do later. }
END; { For Z := 1 to numscreens/pages }
{---------------------------------}
{ get a pointer to the vid buffer }
{---------------------------------}
VioGetBuf( Pointer(IData^.Screen[ 1 ].S),
IData^.Screen[1].ScreenSize, 0 );
{$ELSE}
{---------------------------------------}
{ Determine CRT type; mono, hercules-1, }
{ hercules-2, hercules in-color, cga, }
{ ega, or vga }
{---------------------------------------}
IData^.DisplayMode := 0;
{----------------------}
{ Determine CRT mode, }
{ active screen/page, }
{ and number of cols }
{----------------------}
R.AH := $0F;
R.ES := $0;
R.DS := $0;
Intr( $10, R );
IData^.DisplayMode := R.AL;
IData^.AScreen := R.BH+1;
IData^.Cols := R.AH;
IData^.YMult := IData^.Cols;
{---------------------}
{ Determine # of rows }
{---------------------}
IData^.Rows := Succ(BiosMemMap^.VidVGACurrRow);
If Idata^.Rows<25 Then
Idata^.Rows := 25;
{------------------------------}
{ Determine # of screens/pages }
{------------------------------}
IData^.NumScreens := 8;
{------------------------------}
{ Determine if Font8x8 is used }
{------------------------------}
{ If Vga and rows=50 then yes }
{ If Ega and rows=43 then yes }
{--------------------------------------------------}
{ Check for DV, Win, OS/2, Topview, Doubledos, etc }
{--------------------------------------------------}
{ look it up }
{-----------------------}
{ Get information }
{ For each display page }
{-----------------------}
For Z:= 1 to IData^.NumScreens Do
BEGIN
{--------------------}
{ Get cursor X and Y }
{--------------------}
R.AH :=$03;
R.BH :=Z-1;
R.ES :=$0;
R.DS :=$0;
Intr( $10, R );
IData^.Screen[Z].CurX := R.DL;
IData^.Screen[Z].CurY := R.DH;
{-----------------}
{ Get cursor type }
{-----------------}
{ set it and sync the crt }
{-----------------------}
{ Get Current Attribute }
{-----------------------}
R.AH := $08;
R.BH := Z-1;
R.ES := $0;
R.DS := $0;
Intr( $10, R );
IData^.Screen[Z].CurAttr := (R.AH AND $7F);
{--------------------}
{ Init window coords }
{--------------------}
{ call visionix services to determine window coords }
IData^.Screen[Z].WinX1 := 0;
IData^.Screen[Z].WinY1 := 0;
IData^.Screen[Z].WinX2 := IData^.Cols-1;
IData^.Screen[Z].WinY2 := IData^.Rows-1;
{----------------------------}
{ Get Pointer to screen/page }
{----------------------------}
IData^.Screen[Z].S := NIL;
{ we can't get the pointers to each page }
{ until we switch to the page. we can, }
{ however, get the pointer to the active }
{ page, which we will do later. }
END; { For Z := 1 to numscreens/pages }
{-----------------------------------------}
{ Get offset to current page/screen/store }
{-----------------------------------------}
StoreOfs := BiosMemMap^.VidCurrPageAddr SHR 4;
{-------------------------------------}
{ build pointer to active page/screen }
{-------------------------------------}
If CrtIsMono = TRUE THen
IData^.Screen[ IData^.Ascreen ].S := Ptr( SegB000, $00 )
Else
IData^.Screen[ IData^.Ascreen ].S := Ptr( SegB800+StoreOfs, $00 );
{$ENDIF}
END; { InitCRTIData }
(*
Procedure OutChars( Count : WORD;
Buff : POINTER;
CurX,CurY : PBYTE;
CurAttr : BYTE;
X1,Y1,X2,Y2 : BYTE;
VidMem : POINTER;
YMult : BYTE ); Assembler;
Var
LocalCurX : BYTE;
LocalCurY : BYTE;
DoneSoFar : WORD;
ASM
{ get vars local }
LEA BX, CurX
MOV AL, byte PTR ES:[BX]
MOV LocalCurX, AL
LEA BX, CurY
MOV AL, byte PTR ES:[BX]
MOV LocalCurY, AL
MOV DoneSoFar, 0
@@TIMEAROUND:
{ last column? }
CMP localCurX, X2
JBE @@COLUMN_OK
MOV localCurX, X1
INC localCurY
{ last row? }
CMP LocalCurY, Y2
JBE @@ROW_OK
DEC localCurY
{ yep, scroll da sucker }
MOV AH, 6
MOV BH, CurAttr
MOV AL, 1
MOV CH, X1
MOV CL, Y1
MOV DL, X2
MOV DH, Y2
INT 10h
{ get count we can do this time around }
MOV CX, LocalCurX
SUB CX, X2
MOV AL, CurAttr
{ make ds:si point to source }
PUSH word PTR[Buff+2]
POP DS
MOV BX, word PTR[BUFF]
ADD BX, DoneSoFar
MOV SI, BX
{ make es:di point to dest }
PUSH word PTR [VidMem+2]
POP ES
MOV BX, word PTR [VidMem]
MOV AL, LocalCurY
MUL AL, YMult
ADD AL, X1
ADD AL, X1
ADD AL, LocalCurX
ADD AL, LocalCurX
END;
*)
{────────────────────────────────────────────────────────────────────────}
{$IFDEF OS2}
Procedure SyncScreen;
BEGIN
VioShowBuf( 0, AS^.ScreenSize, 0 );
END;
{$ENDIF}
{---------}
Procedure RegionScroll( X1,Y1,X2,Y2 : WORD;
Count : INTEGER );
Var
Z : INTEGER;
CL: INTEGER;
P : POINTER;
NC: TCell;
Wid : WORD;
BEGIN
Wid := (X2-X1)+1;
NC.Char := ' ';
NC.Attr := AS^.CurAttr;
If Count<0 Then
BEGIN
{ scroll up }
For CL:=1 to Abs(Count) Do
BEGIN
For Z:= Y1 To Pred(Y2) Do
BEGIN
Move( AS^.S^[ ((Z+1)*YMult)+X1 ],
AS^.S^[ (Z*YMult)+X1 ],
Wid*2 );
END; { For Z }
P := Addr( AS^.S^[ (Y2*YMult)+X1 ] );
ASM
LES BX, [p]
MOV AX, NC
MOV CX, Wid
CLD
REPZ STOSW
END;
END;
END
ELSE
BEGIN
{ scroll down/back }
For CL:=1 to Count Do
BEGIN
For Z:= Y2 downTo Y1+1 Do
BEGIN
Move( AS^.S^[ ((Z-1)*YMult)+X1 ],
AS^.S^[ (Z*YMult)+X1 ],
Wid*2 );
END; { For Z }
P := Addr( AS^.S^[ (Y1*YMult)+X1 ] );
ASM
LES BX, [p]
MOV AX, NC
MOV CX, Wid
CLD
REPZ STOSW
END;
END;
{$IFDEF OS2} SyncScreen; {$ENDIF}
END;
END;
{────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RegionRead( X1,Y1,X2,Y2 : WORD;
Region : PScreenStore );
[PARAMETERS]
X1 Source Left Screen Region Coordinate
Y1 Source Top Screen Region Coordinate
X2 Source Right Region Screen Region Coordinate
Y2 Source Bottom Screen Region Coordinate
Region Pointer to Region Read Data
[RETURNS]
(None)
[DESCRIPTION]
Reads a region from the display console to a region store buffer.
"Region" should be a pointer to a buffer which is big enough to hold
the region data. Use RegionMemQuery to determine how many bytes must
be allocated.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RegionRead( X1,Y1,X2,Y2 : WORD;
Region : PScreenStore );
Var
Wid : WORD;
Z : INTEGER;
BEGIN
Wid := (X2-X1)+1;
For Z:= Y1 To Y2 Do
BEGIN
Move( AS^.S^[ (Z*YMult)+X1 ], Region^[ (Z-Y1)*Wid ], Wid*2 );
END; { For Z }
END; { RegionRead }
{────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RegionWrite( X1,Y1,X2,Y2 : WORD;
Region : PScreenStore );
[PARAMETERS]
X1 Left Screen Region Coordinate
Y1 Top Screen Region Coordinate
X2 Right Region Screen Region Coordinate
Y2 Bottom Screen Region Coordinate
Region Pointer to Region Write Data
[RETURNS]
(None)
[DESCRIPTION]
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RegionWrite( X1,Y1,X2,Y2 : WORD;
Region : PScreenStore );
Var
Wid : WORD;
Z : INTEGER;
BEGIN
Wid := (X2-X1)+1;
For Z:= Y1 To Y2 Do
BEGIN
Move( Region^[ (Z-Y1)*Wid ], AS^.S^[ (Z*YMult)+X1 ], Wid*2 );
END; { For Z }
END; { RegionWrite }
{────────────────────────────────────────────────────────────────────────}
Procedure RealCursorGoto( S,X,Y : BYTE );
BEGIN
{$IFDEF OS2}
VioSetCurPos( Y, X, 0 );
{$ELSE}
ASM
{-------------------------------}
{ Sync the actual cursor to the }
{ address CurX, CurY }
{-------------------------------}
{ PUSH DS}
MOV DH, Y
MOV DL, X
MOV BH, S
MOV AH, 2
{
MOV CX, 0
MOV DS, CX
MOV ES, CX
}
INT 10h
{ POP DS}
END;
{$ENDIF}
END; { RealCursorGoto }
{────────────────────────────────────────────────────────────────────────}
Procedure CursorDown( Sync : BOOLEAN );
BEGIN
With AS^ Do
BEGIN
Inc( CurY );
If CurY > WinY2 Then
BEGIN
RegionScroll( WinX1,
WinY1,
WinX2,
WinY2,
-1 );
Dec( CurY );
END; { If CurY }
If (Sync) and (IData^.VirtualCRT=FALSE) Then
RealCursorGoto( IData^.AScreen-1, CurX, CurY );
END; { With AS^ }
END; { CursorDown }
{────────────────────────────────────────────────────────────────────────}
Procedure CursorNextChar( Sync : BOOLEAN );
BEGIN
With AS^ Do
BEGIN
Inc( CurX );
If CurX > WinX2 Then
BEGIN
CurX := WinX1;
CursorDown( Sync );
END; { If CurX }
If (Sync) and (IData^.VirtualCRT=FALSE) Then
RealCursorGoto( IData^.AScreen-1, CurX, CurY );
END; { With AS^ }
END; { CursorNextChar }
{────────────────────────────────────────────────────────────────────────}
Procedure SwapCoords( Var A,B : WORD );
Var
Temp : WORD;
BEGIN
Temp := A;
A := B;
B := Temp;
END; { SwapCoords }
{────────────────────────────────────────────────────────────────────────}
Procedure MySetCursorType( CurType : WORD );
{$IFNDEF OS2}
Var
R : REGISTERS;
BEGIN
R.AH := $1;
R.ES := $0;
R.DS := $0;
Case CurType of
cctNone : R.CX := $2000;
cctSmall : R.CX := $0607;
cctHalf : R.CX := $0407;
cctBig : R.CX := $0007;
ELSE
R.CX := $0607;
END;
Intr( $10, R );
END;
{$ELSE}
BEGIN
END;
{$ENDIF} { if notdef os2 / else }
{────────────────────────────────────────────────────────────────────────}
Procedure MyClrScr;
Var
P : POINTER;
Z2 : INTEGER;
Wid : WORD;
NC : TCell;
BEGIN
With AS^ DO
BEGIN
Wid := (WinX2-WinX1)+1;
NC.Char := ' ';
NC.Attr := AS^.CurAttr;
For Z2:=WinY1 to WinY2 Do
BEGIN
P := Addr( AS^.S^[ (Z2*YMult)+WinX1 ] );
ASM
LES BX, [p]
MOV AX, NC
MOV CX, Wid
CLD
REPZ STOSW
END;
END; { For Z2 (y) }
CurX := WinX1;
CurY := WinY1;
If Idata^.VirtualCRT=FALSE Then
RealCursorGoto( IData^.Ascreen-1, CurX, Cury );
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { myclrscr }
{────────────────────────────────────────────────────────────────────────}
BEGIN { CRTOutDriverProc }
CallNext := TRUE;
IData := ODP^.ID;
If ODP^.Func<> ODF_DriverNew Then
BEGIN
AS := @IData^.Screen[ IData^.AScreen ];
YMult := IData^.YMult;
END; { ODP^.Func }
If ODP^.Status = 0 Then
BEGIN
Case ODP^.Func Of
ODF_WriteBlock:
BEGIN
With AS^ DO
BEGIN
For Z:=ODP^.Start to ODP^.Size Do
BEGIN
Case PCharBuff( ODP^.Buff)^[Z] Of
#13:
BEGIN
CurX := WinX1;
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { #13 }
#10:
BEGIN
CursorDown( TRUE );
END;
Else
S^[ (CurY*YMult)+CurX ].Char := PCharBuff( ODP^.Buff )^[Z];
S^[ (CurY*YMult)+CurX ].Attr := CurAttr;
CursorNextChar( FALSE );
END; { Case PCharBuff( ODP^.Buf)^[Z] }
END; { For Z }
{ sync the cursor }
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
ODP^.Start := ODP^.Size;
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_WriteBlock }
{----}
ODF_WriteChar:
BEGIN
With AS^ Do
BEGIN
Case ODP^.Ch Of
#13:
BEGIN
CurX := WinX1;
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { #13 }
#10:
BEGIN
CursorDown( TRUE );
END; { #10 }
Else
S^[ (CurY*YMult)+CurX ].Char := ODP^.CH;
S^[ (CurY*YMult)+CurX ].Attr := CurAttr;
CursorNextChar( TRUE );
END; { Case ODP^.Ch }
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_WriteChar }
{----}
ODF_DriverNew:
BEGIN
IF @ODP^.OutDriverProc = @CRTOutDriverProc Then
BEGIN
{-------------------------}
{ Get a new Instance Data }
{ master node. }
{-------------------------}
New( Idata );
{---------------------------------------------------}
{ Here we check to see if we are being inited as an }
{ actual CRT memory driver or if we are beign setup }
{ as a virtual CRT driver. }
{---------------------------------------------------}
If ( ODP^.DriverParam1 = 0 ) or
( ODP^.DriverParam2 = 0 ) Then
BEGIN
Idata^.VirtualCRT := FALSE;
{----------------------------------}
{ Set IData up for the CGA/EGA/VGA }
{ monochrome text display mode }
{----------------------------------}
InitCRTIData;
{--------}
{ Return }
{--------}
ODP^.Status := ODS_Install+ODS_Changed;
ODP^.ID := IData;
END { If ODP^.Driverinfo }
ELSE
BEGIN
{-------------------------------------------}
{ DriverData --> virtual CRT driverinfo, so }
{ we allocate virtual screen stores and }
{ run in virtual CRT mode. }
{-------------------------------------------}
IData^.VirtualCRT := TRUE;
IData^.Name := ODP^.Name^;
IData^.Off := 0;
IData^.Cols := PVCRTDriverInfo( ODP^.DriverParam2 )^.Cols;
IData^.Rows := PVCRTDriverInfo( ODP^.DriverParam2 )^.Rows;
IData^.NumScreens := PVCRTDriverInfo( ODP^.DriverParam2 )^.Screens;
IData^.YMult := IData^.Cols;
{------------------------}
{ Get the Virtual Screen }
{ stores. }
{------------------------}
Z := (IData^.Cols) * (IData^.Rows) * SizeOf( TCell );
For Z2 := 1 to IData^.NumScreens Do
BEGIN
GetMem( IData^.Screen[Z2].S, Z );
IData^.Screen[Z2].CurX := 1;
IData^.Screen[Z2].CurY := 1;
IData^.Screen[Z2].CurAttr := $07;
IData^.Screen[Z2].WinX1 := 1;
IData^.Screen[Z2].WinY1 := 1;
IData^.Screen[Z2].WinX2 := Idata^.Cols;
IData^.Screen[Z2].WinY2 := Idata^.Rows;
IData^.Screen[Z2].CurType := 0;
END;
{-----------------------}
{ Set the active screen }
{-----------------------}
IData^.AScreen := 1;
{--------}
{ Return }
{--------}
ODP^.Status := ODS_Install+ODS_Changed;
ODP^.ID := IData;
END; {IF ODP^.Driverinfo / Else }
END; { If ODP^.OutDriverProc --> Us }
END; { ODF_DriverNew }
{----}
ODF_DriverOff:
BEGIN
If ODP^.Name^ = IData^.Name Then
BEGIN
Inc( Idata^.Off );
END; { If ODP^.Name^ }
END; { ODF_DriverOff }
{----}
ODF_DriverOn:
BEGIN
If ODP^.Name^ = IData^.Name Then
BEGIN
If Idata^.Off <> 0 Then
Dec( Idata^.Off );
END; { ODP^.Name^ }
END; { ODF_DriverOn }
{----}
ODF_DriverDispose:
BEGIN
If ODP^.Name^ = IData^.Name Then
BEGIN
{RemoveFromOutDriverStack }
Dispose( IData );
END; { If ODP^.Name^ }
END; { ODF_DriverDispose }
{----}
ODF_WriteVert:
BEGIN
With AS^ DO
BEGIN
For Z:=1 to ODP^.Size Do
BEGIN
S^[ (CurY*YMult)+CurX ].Char := PCharBuff( ODP^.Buff )^[Z];
S^[ (CurY*YMult)+CurX ].Attr := CurAttr;
CursorDown( TRUE );
END; { For Z }
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_WriteVert }
{----}
ODF_WriteCharAt:
BEGIN
With AS^ Do
BEGIN
S^[ (Pred(ODP^.Y1)*YMult)+Pred(ODP^.X1) ].Char := ODP^.CH;
S^[ (Pred(ODP^.Y1)*YMult)+Pred(ODP^.X1) ].Attr :=
CRTColorMap[ ODP^.Attr ];
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_WriteCharAt }
{----}
ODF_WriteBlockAt:
BEGIN
With AS^ DO
BEGIN
SaveCurX := CurX;
SaveCurY := CurY;
For Z:=1 to ODP^.Size Do
BEGIN
S^[ (Pred(ODP^.Y1)*YMult)+ODP^.X1+Z-2].Char :=
PCharBuff( ODP^.Buff )^[Z];
S^[ (Pred(ODP^.Y1)*YMult)+ODP^.X1+Z-2].Attr :=
CRTColorMap[ ODP^.Attr ];
END; { For Z }
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_WriteBlockAt }
{----}
ODF_WriteVertAt:
BEGIN
With AS^ DO
BEGIN
For Z:=1 to ODP^.Size Do
BEGIN
S^[ ((ODP^.Y1+Z-2)*YMult)+Pred(ODP^.X1) ].Char :=
PCharBuff( ODP^.Buff )^[Z];
S^[ ((ODP^.Y1+Z-2)*YMult)+Pred(ODP^.X1) ].Attr :=
CRTColorMap[ ODP^.Attr ];
END; { For Z }
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_WriteVertAt }
{----}
ODF_ClrEOL:
BEGIN
With AS^ DO
BEGIN
For Z:=CurX to WinX2 Do
BEGIN
S^[ (CurY*YMult)+Z ].Char := ' ';
S^[ (CurY*YMult)+Z ].Attr := CurAttr;
END; { For Z }
{ Cursor to next line? }
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_ClrEOL }
{----}
ODF_ClrScr:
BEGIN
MyClrScr;
END; { ODF_ClrScr }
{----}
ODF_DelLine:
BEGIN
With AS^ Do
BEGIN
RegionScroll( WinX1,
CurY,
WinX2,
WinY2,
-1 );
{ Cursor to WinX1?? }
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_DelLine }
{----}
ODF_InsLine:
BEGIN
With AS^ Do
BEGIN
RegionScroll( WinX1,
CurY,
WinX2,
WinY2,
1 );
{ Cursor to WinX1?? }
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_InsLine }
{----}
ODF_GotoXY:
BEGIN
With AS^Do
BEGIN
CurX := WinX1+(ODP^.X1-1);
CurY := WinY1+(ODP^.Y1-1);
If (IData^.VirtualCRT=FALSE) Then
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { With AS^ }
END; { ODF_GotoXY }
{----}
ODF_Window:
BEGIN
With AS^ Do
BEGIN
WinX1 := ODP^.X1-1;
WinY1 := ODP^.Y1-1;
WinX2 := ODP^.X2-1;
WinY2 := ODP^.Y2-1;
If WinX2<WinX1 Then SwapCoords( WinX1, WinX2 );
If WinY2<WinY1 Then SwapCoords( WinY1, WinY2 );
CurX := WinX1;
CurY := WinY1;
If (IData^.VirtualCRT=FALSE) Then
RealCursorGoto( IData^.Ascreen-1, CurX, Cury );
{ call visionix services to set window coords }
END; { With AS^ }
END; { ODF_Window }
{----}
{ 7 6 5 4 3 2 1 0 }
{ F B B B T T T T }
ODF_ColorText:
BEGIN
With AS^ Do
BEGIN
CurAttr := (CurAttr AND $F0) + (ODP^.TheColor AND $0F);
END; { With AS^ }
END; { ODF_ColorText }
{----}
ODF_ColorBack:
BEGIN
With AS^ Do
BEGIN
CurAttr := (CurAttr AND $0F) + ((ODP^.TheColor AND $07) SHL 4);
END; { With AS^ }
END; { ODF_ColorBack }
{----}
ODF_GetWin:
BEGIN
With AS^ Do
BEGIN
ODP^.X1 := WinX1+1;
ODP^.Y1 := WinY1+1;
ODP^.X2 := WinX2+1;
ODP^.Y2 := WinY2+1;
ODP^.Status := ODS_Changed;
END; { With AS^ }
END; { ODF_GetWin }
{----}
ODF_GetAttr:
BEGIN
ODP^.Attr := AS^.CurAttr;
ODP^.Status := ODS_Changed;
END; { ODF_GetAttr }
{----}
ODF_SetAttr:
BEGIN
AS^.CurAttr := ODP^.Attr;
END; { ODF_SetAttr }
{----}
ODF_GetXY:
BEGIN
ODP^.X1 := (AS^.CurX+1)-AS^.WinX1;
ODP^.Y1 := (AS^.CurY+1)-AS^.WinY1;
ODP^.Status := ODS_Changed;
END; { ODF_GetXY }
{----}
ODF_GetNumScreens:
BEGIN
ODP^.Screens := IData^.NumScreens;
ODP^.Status := ODS_Changed;
END; { ODF_GetNumScreens }
{----}
ODF_GoScreen:
BEGIN
If ODP^.Screens <= IData^.NumScreens Then
IData^.AScreen := ODP^.Screens;
END; { ODF_GoScreen }
{----}
ODF_SetCursorType:
BEGIN
MySetCursorType( ODP^.NumVal );
AS^.CurType := ODP^.NumVal;
END; { ODF_SetCursorType }
{----}
ODF_DrawVLine:
BEGIN
END; { ODF_DrawVLine }
{----}
ODF_DrawHLine:
BEGIN
END; { ODF_DrawHLine }
{----}
ODF_DrawBox:
BEGIN
END; { ODF_DrawBox }
{----}
ODF_ReadChar:
BEGIN
ODP^.CH := AS^.S^[ (Pred(ODP^.Y1)*YMult)+Pred(ODP^.X1) ].Char;
ODP^.Status := ODS_Changed;
END; { ODF_ReadChar }
{----}
ODF_ReadAttr:
BEGIN
ODP^.Attr := AS^.S^[ (Pred(ODP^.Y1)*YMult)+ODP^.X1-1 ].Attr;
ODP^.Status := ODS_Changed;
END; { ODF_ReadAttr }
{----}
ODF_WriteAttr:
BEGIN
AS^.S^[ (Pred(ODP^.Y1)*YMult)+ODP^.X1-1 ].Attr :=
CRTColorMap[ ODP^.Attr ];
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_WriteAttr }
{----}
ODF_QueryRegion:
BEGIN
ODP^.RegionSize := ((ODP^.Y2-ODP^.Y1)+1)*((ODP^.X2-ODP^.X1)+1)*2;
ODP^.Status := ODS_Changed;
END; { ODF_QueryRegion }
{----}
ODF_ReadRegion:
BEGIN
If ODP^.Status AND ODS_Changed=0 Then
RegionRead( Pred(ODP^.X1), Pred(ODP^.Y1),
Pred(ODP^.X2), Pred(ODP^.Y2), ODP^.Region );
ODP^.Status := ODS_Changed;
END; { ODF_ReadRegion }
{----}
ODF_WriteRegion:
BEGIN
RegionWrite( ODP^.X1-1, ODP^.Y1-1,
ODP^.X2-1, ODP^.Y2-1, ODP^.Region );
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_WriteRegion }
{----}
ODF_DriverRenew:
BEGIN
END; { ODF_DriverRenew }
{----}
ODF_CursorUp:
BEGIN
With AS^Do
BEGIN
(*
If (CurY-ODP^.Numval) >= WinY1 Then
Dec( CurY, ODP^.NumVal )
Else
CurY := WinY1;
*)
For Z:=1 to ODP^.NumVal Do
If CurY>WinY1 Then
Dec(CurY);
If (IData^.VirtualCRT=FALSE) Then
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { With AS^ }
END; { ODF_CursorUp }
{----}
ODF_CursorDown:
BEGIN
With AS^Do
BEGIN
(*
If (CurY+ODP^.Numval) <= WinY2 Then
Inc( CurY, ODP^.NumVal )
Else
CurY := WinY2;
*)
For Z:=1 to ODP^.NumVal Do
If CurY<WinY2 Then
Inc(CurY);
If (IData^.VirtualCRT=FALSE) Then
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { With AS^ }
END; { ODF_CursorDown }
{----}
ODF_CursorLeft:
BEGIN
With AS^ Do
BEGIN
(*
If (CurX-ODP^.Numval) >= WinX1 Then
Dec( CurY, ODP^.NumVal )
Else
CurX := WinX1;
*)
For Z:=1 to ODP^.Numval Do
If CurX>WinX1 Then
Dec(CurX);
If (IData^.VirtualCRT=FALSE) Then
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { With AS^ }
END; { ODF_CursorLeft }
{----}
ODF_CursorRight:
BEGIN
With AS^Do
BEGIN
(*
If (CurX+ODP^.NumVal) <= WinX2 Then
Inc( CurX, ODP^.NumVal )
Else
CurY := WinX2;
*)
For Z:=1 to ODP^.Numval Do
If CurX<WinX2 Then
Inc(CurX);
If (IData^.VirtualCRT=FALSE) Then
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { With AS^ }
END; { ODF_CursorRight }
{----}
ODF_RegionScrUp:
BEGIN
RegionScroll( Pred(ODP^.X1), Pred(ODP^.Y1),
Pred(ODP^.X2), Pred(ODP^.Y2),
0-ODP^.NumVal );
END; { ODF_RegionScrUp }
{----}
ODF_RegionScrDown:
BEGIN
RegionScroll( Pred(ODP^.X1), Pred(ODP^.Y1),
Pred(ODP^.X2), Pred(ODP^.Y2),
ODP^.NumVal );
END; { ODF_RegionScrDown }
{----}
ODF_RegionCopy:
BEGIN
END; { ODF_RegionCopy }
{----}
ODF_RegionFill:
BEGIN
With AS^ DO
BEGIN
For Z2:=Pred(ODP^.Y1) to Pred(ODP^.Y2) Do
BEGIN
For Z:=Pred(ODP^.X1) to Pred(ODP^.X2) Do
BEGIN
S^[ (Z2*YMult)+Z ].Char := ODP^.CH;
S^[ (Z2*YMult)+Z ].Attr := ODP^.Attr;
END; { For Z (x) }
END; { For Z2 (y) }
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_RegionFill }
{----}
ODF_RegionFillA:
BEGIN
With AS^ DO
BEGIN
For Z2:=Pred(ODP^.Y1) to Pred(ODP^.Y2) Do
BEGIN
For Z:=Pred(ODP^.X1) to Pred(ODP^.X2) Do
BEGIN
S^[ (Z2*YMult)+Z ].Attr := ODP^.Attr;
END; { For Z (x) }
END; { For Z2 (y) }
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_RegionFillA }
{----}
ODF_RegionFillC:
BEGIN
With AS^ DO
BEGIN
For Z2:=Pred(ODP^.Y1) to Pred(ODP^.Y2) Do
BEGIN
For Z:=Pred(ODP^.X1) to Pred(ODP^.X2) Do
BEGIN
S^[ (Z2*YMult)+Z ].Char := ODP^.CH;
END; { For Z (x) }
END; { For Z2 (y) }
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_RegionFillC }
{----}
ODF_RepeatChar:
BEGIN
With AS^ Do
BEGIN
IF (ODP^.CH<>#13) and (ODP^.CH<>#10) Then
BEGIN
For Z:=1 to ODP^.NumVal Do
BEGIN
S^[ (CurY*YMult)+CurX ].Char := ODP^.CH;
S^[ (CurY*YMult)+CurX ].Attr := CurAttr;
CursorNextChar( FALSE );
END; { For Z }
If (IData^.VirtualCRT=FALSE) Then
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { If ODP^.Ch }
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_RepeatChar }
{----}
ODF_RepeatCharAt:
BEGIN
With AS^ DO
BEGIN
SaveCurX := CurX;
SaveCurY := CurY;
For Z:=1 to ODP^.NumVal Do
BEGIN
S^[ (Pred(ODP^.Y1)*YMult)+ODP^.X1+Z-2].Char := ODP^.CH;
S^[ (Pred(ODP^.Y1)*YMult)+ODP^.X1+Z-2].Attr :=
CRTColorMap[ ODP^.Attr ];
END; { For Z }
END; { With AS^ }
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_RepeatCharAt }
{----}
ODF_GetScreenSize:
BEGIN
With AS^ Do
BEGIN
ODP^.X1 := IData^.Cols;
ODP^.Y1 := Idata^.Rows;
END; { With AS^ }
END; { ODF_GetScreenSize }
{----}
ODF_RepeatBlock:
BEGIN
With AS^ DO
BEGIN
Z3 := ODP^.Start;
For Z2:=1 to ODP^.NumVal Do
BEGIN
For Z:=Z3 to ODP^.Size Do
BEGIN
Case PCharBuff( ODP^.Buff)^[Z] Of
#13:
BEGIN
CurX := WinX1;
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { #13 }
#10:
BEGIN
CursorDown( TRUE );
END;
Else
S^[ (CurY*YMult)+CurX ].Char := PCharBuff( ODP^.Buff )^[Z];
S^[ (CurY*YMult)+CurX ].Attr := CurAttr;
CursorNextChar( FALSE );
END; { Case PCharBuff( ODP^.Buf)^[Z] }
END; { For Z }
Z3 := 1;
END; { for Z2 }
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { With AS^ }
ODP^.Start := ODP^.Size;
{$IFDEF OS2} SyncScreen; {$ENDIF}
END; { ODF_Repeatblock }
{----}
{----}
Else { Else Case }
END; { Case ODP^.Func }
END; { If ODP^.Status = 0 }
CallNextDriver( ODP );
END; { CRTOutDriverProc }
{────────────────────────────────────────────────────────────────────────────}
{$IFDEF OS2}
Procedure VIOOutDriverProc( ODP : POutDriverPacket );
Type
TCharBuff = Array[1..32768] of CHAR;
PCharBuff = ^TCharBuff;
{----}
TCell = Record
Char : CHAR;
Attr : BYTE;
END; { TCell }
{----}
TScreenStore = Array[0..32000] of TCell;
PScreenStore = ^TScreenStore;
{----}
TScreen = RECORD
CurX : WORD;
CurY : WORD;
CurAttr : BYTE;
WinX1 : WORD;
WinX2 : WORD;
WinY1 : WORD;
WinY2 : WORD;
CurType : WORD;
ScreenSize: WORD;
S : PScreenStore;
END; { TScreen }
PScreen = ^TScreen;
{----}
TVIOOutDriverIData = Record
Off : WORD;
Name : TProcName;
VirtualCRT : BOOLEAN;
DisplayMode: BYTE;
Cols : WORD;
Rows : WORD;
YMult : WORD;
NumScreens : BYTE;
AScreen : BYTE;
Screen : Array[1..8] of TScreen;
MyODP : TOutDriverPacket;
END; { TVIOOutDriverIData }
PVIOOutDriverIData = ^TVIOOutDriverIData;
{----}
TVCRTDriverInfo = RECORD
Cols : WORD;
Rows : WORD;
Screens : WORD;
END; { TVCRTDriverInfo }
PVCRTDriverInfo = ^TVCRTDriverInfo;
MyPByte = ^Byte;
MyPWord = ^Word;
Var
IData : PVIOOutDriverIData;
YMult : WORD;
AS : PScreen;
Z : INTEGER;
Z2 : INTEGER;
Z3 : INTEGER;
TheCell : TCell;
SaveCurX : WORD;
SaveCurY : WORD;
CallNext : BOOLEAN;
{────────────────────────────────────────────────────────────────────────}
Procedure InitVIOIdata;
Type
MyPtrWord = ^WORD;
Var
{$IFNDEF OS2}
R : REGISTERS;
{$ENDIF}
Z : INTEGER;
StoreOfs : WORD;
VMI : TVIOModeInfo;
BEGIN
{---------------------------------------}
{ Determine CRT type; mono, hercules-1, }
{ hercules-2, hercules in-color, cga, }
{ ega, or vga }
{---------------------------------------}
{$IFDEF DEBUG}
DebugWrite('VioGetMode...');
{$ENDIF}
VMI.CB := 12; { have to setup byte count of record first }
VioGetMode( VMI, 0 );
{$IFDEF DEBUG }
Write( DebugFile, 'DONE.');
WriteLN( DebugFile, ' Cols=',vmi.cols,' Rows=',vmi.rows );
{$ENDIF}
IData^.DisplayMode := 3;
IData^.AScreen := 1;
IData^.Cols := VMI.Cols;
IData^.Rows := VMI.Rows;
IData^.YMult := IData^.Cols;
{------------------------------}
{ Determine # of screens/pages }
{------------------------------}
IData^.NumScreens := 1;
{------------------------------}
{ Determine if Font8x8 is used }
{------------------------------}
{ If Vga and rows=50 then yes }
{ If Ega and rows=43 then yes }
{-----------------------}
{ Get information }
{ For each display page }
{-----------------------}
For Z:= 1 to IData^.NumScreens Do
BEGIN
{--------------------}
{ Get cursor X and Y }
{--------------------}
{$IFDEF DEBUG}
DebugWrite('VioGetCurPos...');
{$ENDIF}
VioGetCurPos( IData^.Screen[Z].CurY,
IData^.Screen[Z].CurX,
0 );
{$IFDEF DEBUG}
WriteLN( DebugFile, 'DONE. CurX=',IData^.Screen[Z].CurX,
' CurY=',IData^.Screen[Z].CurY );
{$ENDIF}
idata^.screen[z].cury := 0;
idata^.screen[z].curx := 0;
{-----------------}
{ Get cursor type }
{-----------------}
{ set it and sync the crt }
{-----------------------}
{ Get Current Attribute }
{-----------------------}
IData^.Screen[Z].CurAttr := 7;
{--------------------}
{ Init window coords }
{--------------------}
{ call visionix services to determine window coords }
IData^.Screen[Z].WinX1 := 0;
IData^.Screen[Z].WinY1 := 0;
IData^.Screen[Z].WinX2 := IData^.Cols-1;
IData^.Screen[Z].WinY2 := IData^.Rows-1;
{----------------------------}
{ Get Pointer to screen/page }
{----------------------------}
IData^.Screen[Z].S := NIL;
{ we can't get the pointers to each page }
{ until we switch to the page. we can, }
{ however, get the pointer to the active }
{ page, which we will do later. }
END; { For Z := 1 to numscreens/pages }
{---------------------------------}
{ get a pointer to the vid buffer }
{---------------------------------}
{$IFDEF DEBUG}
DebugWrite('VioGetBuf...');
{$ENDIF}
VioGetBuf( Pointer(IData^.Screen[ 1 ].S),
IData^.Screen[1].ScreenSize, 0 );
{$IFDEF DEBUG}
DebugWriteLn('DONE.');
{$ENDIF}
END; { InitCRTIData }
{────────────────────────────────────────────────────────────────────────}
Procedure SyncScreen;
BEGIN
VioShowBuf( 0, AS^.ScreenSize, 0 );
END;
{---------}
Procedure RegionScroll( X1,Y1,X2,Y2 : WORD;
Count : INTEGER );
Var
NC : TCell;
BEGIN
{ x/y coords come in relative to zero }
NC.Char := ' ';
NC.Attr := AS^.CurAttr;
If Count<0 Then
BEGIN
{ scroll up }
VioScrollUp( Y1,X1,
Y2,X2,
Abs( Count ),
@NC,
0 );
END
ELSE
BEGIN
{ scroll down/back }
VioScrollDn( Y1,X1,
Y2,X2,
Count,
@NC,
0 );
END;
END;
{────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RegionRead( X1,Y1,X2,Y2 : WORD;
Region : PScreenStore );
[PARAMETERS]
X1 Source Left Screen Region Coordinate
Y1 Source Top Screen Region Coordinate
X2 Source Right Region Screen Region Coordinate
Y2 Source Bottom Screen Region Coordinate
Region Pointer to Region Read Data
[RETURNS]
(None)
[DESCRIPTION]
Reads a region from the display console to a region store buffer.
"Region" should be a pointer to a buffer which is big enough to hold
the region data. Use RegionMemQuery to determine how many bytes must
be allocated.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RegionRead( X1,Y1,X2,Y2 : WORD;
Region : PScreenStore );
Var
Wid : WORD;
Wid2 : WORD;
Z : INTEGER;
BEGIN
{ x/y coords come in relative to zero }
Wid := (X2-X1)+1;
For Z:= Y1 To Y2 Do
BEGIN
Wid2 := Wid*2;
VioReadCellStr( @Region^[ (Z-Y1)*Wid ],
Wid2,
Z ,
X1 ,
0 );
END; { For Z }
END; { RegionRead }
{────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RegionWrite( X1,Y1,X2,Y2 : WORD;
Region : PScreenStore );
[PARAMETERS]
X1 Left Screen Region Coordinate
Y1 Top Screen Region Coordinate
X2 Right Region Screen Region Coordinate
Y2 Bottom Screen Region Coordinate
Region Pointer to Region Write Data
[RETURNS]
(None)
[DESCRIPTION]
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RegionWrite( X1,Y1,X2,Y2 : WORD;
Region : PScreenStore );
Var
Wid : WORD;
Wid2 : WORD;
Z : INTEGER;
BEGIN
{ x/y coords come in relative to 0 }
Wid := (X2-X1)+1;
Wid2 := Wid*2;
For Z:= Y1 To Y2 Do
BEGIN
VioWrtCellStr( @Region^[ (Z-Y1)*Wid ],
Wid2,
Z ,
X1 ,
0 );
END; { For Z }
END; { RegionWrite }
{────────────────────────────────────────────────────────────────────────}
Procedure RealCursorGoto( S,X,Y : BYTE );
BEGIN
VioSetCurPos( Y,
X,
0 );
END; { RealCursorGoto }
{────────────────────────────────────────────────────────────────────────}
Procedure CursorDown( Sync : BOOLEAN );
BEGIN
With AS^ Do
BEGIN
Inc( CurY );
If CurY > WinY2 Then
BEGIN
RegionScroll( WinX1,
WinY1,
WinX2,
WinY2,
-1 );
Dec( CurY );
END; { If CurY }
If (Sync) Then
RealCursorGoto( IData^.AScreen-1, CurX, CurY );
END; { With AS^ }
END; { CursorDown }
{────────────────────────────────────────────────────────────────────────}
Procedure CursorNextChar( Sync : BOOLEAN );
BEGIN
With AS^ Do
BEGIN
Inc( CurX );
If CurX > WinX2 Then
BEGIN
CurX := WinX1;
CursorDown( Sync );
END; { If CurX }
If (Sync) Then
RealCursorGoto( IData^.AScreen-1, CurX, CurY );
END; { With AS^ }
END; { CursorNextChar }
{────────────────────────────────────────────────────────────────────────}
Procedure SwapCoords( Var A,B : WORD );
Var
Temp : WORD;
BEGIN
Temp := A;
A := B;
B := Temp;
END; { SwapCoords }
{────────────────────────────────────────────────────────────────────────}
Procedure MySetCursorType( CurType : WORD );
Var
VCI : TVioCursorInfo;
BEGIN
VioGetCurType( VCI, 0 );
Case CurType of
cctNone:
BEGIN
VCI.Attr := $FFFF;
END;
cctSmall:
BEGIN
VCI.ScanStart := $06;
VCI.ScanEnd := $07;
VCI.Attr := AS^.CurAttr;
END;
cctHalf:
BEGIN
VCI.ScanStart := $04;
VCI.ScanEnd := $07;
VCI.Attr := AS^.CurAttr;
END;
cctBig:
BEGIN
VCI.ScanStart := $00;
VCI.ScanEnd := $07;
VCI.Attr := AS^.CurAttr;
END;
ELSE
VCI.ScanStart := $06;
VCI.ScanEnd := $07;
VCI.Attr := AS^.CurAttr;
END;
VioSetCurType( @VCI, 0 );
END;
{────────────────────────────────────────────────────────────────────────}
BEGIN { VIOOutDriverProc }
CallNext := TRUE;
IData := ODP^.ID;
If ODP^.Func<> ODF_DriverNew Then
BEGIN
AS := @IData^.Screen[ IData^.AScreen ];
YMult := IData^.YMult;
{$IFDEF DEBUG}
WriteLN( DebugFile, 'VIOOutDriverProc, ODP^.Func=',ODP^.Func );
DebugWriteLN('');
{$ENDIF}
END; { ODP^.Func }
If ODP^.Status = 0 Then
BEGIN
Case ODP^.Func Of
ODF_WriteBlock:
BEGIN
With AS^ DO
BEGIN
TheCell.Attr := CurAttr;
For Z:=ODP^.Start to ODP^.Size Do
BEGIN
Case PCharBuff( ODP^.Buff)^[Z] Of
#13:
BEGIN
CurX := WinX1;
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { #13 }
#10:
BEGIN
CursorDown( TRUE );
END;
Else
TheCell.Char := PCharBuff( ODP^.Buff )^[Z];
VioWrtCellStr( @TheCell,
2,
CurY,
CurX,
0 );
{ CursorNextChar( TRUE ); }
CursorNextChar( FALSE );
END; { Case PCharBuff( ODP^.Buf)^[Z] }
END; { For Z }
RealCursorGoto( IData^.AScreen-1, CurX, CurY );
ODP^.Start := ODP^.Size;
END; { With AS^ }
END; { ODF_WriteBlock }
{----}
ODF_WriteChar:
BEGIN
With AS^ Do
BEGIN
Case ODP^.Ch Of
#13:
BEGIN
CurX := WinX1;
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { #13 }
#10:
BEGIN
CursorDown( TRUE );
END; { #10 }
Else
TheCell.Char := ODP^.CH;
TheCell.Attr := CurAttr;
VioWrtCellStr( @TheCell,
2,
CurY,
CurX,
0 );
CursorNextChar( TRUE );
END; { Case ODP^.Ch }
END; { With AS^ }
END; { ODF_WriteChar }
{----}
ODF_DriverNew:
BEGIN
IF @ODP^.OutDriverProc = @VIOOutDriverProc Then
BEGIN
{-------------------------}
{ Get a new Instance Data }
{ master node. }
{-------------------------}
New( Idata );
Idata^.VirtualCRT := FALSE;
{----------------------------------}
{ Set IData up for the CGA/EGA/VGA }
{ monochrome text display mode }
{----------------------------------}
InitVIOIData;
{--------}
{ Return }
{--------}
ODP^.Status := ODS_Install+ODS_Changed;
ODP^.ID := IData;
END; { If ODP^.OutDriverProc --> Us }
END; { ODF_DriverNew }
{----}
ODF_DriverOff:
BEGIN
If ODP^.Name^ = IData^.Name Then
BEGIN
Inc( Idata^.Off );
END; { If ODP^.Name^ }
END; { ODF_DriverOff }
{----}
ODF_DriverOn:
BEGIN
If ODP^.Name^ = IData^.Name Then
BEGIN
If Idata^.Off <> 0 Then
Dec( Idata^.Off );
END; { ODP^.Name^ }
END; { ODF_DriverOn }
{----}
ODF_DriverDispose:
BEGIN
If ODP^.Name^ = IData^.Name Then
BEGIN
{RemoveFromOutDriverStack }
Dispose( IData );
END; { If ODP^.Name^ }
END; { ODF_DriverDispose }
{----}
ODF_WriteVert:
BEGIN
With AS^ DO
BEGIN
TheCell.Attr := CurAttr;
For Z:=1 to ODP^.Size Do
BEGIN
TheCell.Char := PCharBuff( ODP^.Buff )^[Z];
VioWrtCellStr( @TheCell,
2,
CurY,
CurX,
0 );
CursorDown( TRUE );
END; { For Z }
END; { With AS^ }
END; { ODF_WriteVert }
{----}
ODF_WriteCharAt:
BEGIN
With AS^ Do
BEGIN
TheCell.Char := ODP^.CH;
TheCell.Attr := ODP^.Attr;
VioWrtCellStr( @TheCell,
2,
Pred(ODP^.Y1),
Pred(ODP^.X1),
0 );
(*
S^[ (Pred(ODP^.Y1)*YMult)+Pred(ODP^.X1) ].Char := ODP^.CH;
S^[ (Pred(ODP^.Y1)*YMult)+Pred(ODP^.X1) ].Attr :=
CRTColorMap[ ODP^.Attr ];
*)
END; { With AS^ }
END; { ODF_WriteCharAt }
{----}
ODF_WriteBlockAt:
BEGIN
With AS^ DO
BEGIN
VioWrtCharStrAttr( ODP^.Buff,
ODP^.Size,
Pred( ODP^.Y1 ),
Pred( ODP^.X1 ),
@ODP^.Attr,
0 );
(*
TheCell.Attr := ODP^.Attr;
For Z:=1 to ODP^.Size Do
BEGIN
TheCell.Char := PCharBuff( ODP^.Buff )^[Z];
VioWrtCellStr( @TheCell,
2,
Pred(ODP^.Y1),
ODP^.X1+Z-2,
0 );
END; { For Z }
*)
END; { With AS^ }
END; { ODF_WriteBlockAt }
{----}
ODF_WriteVertAt:
BEGIN
With AS^ DO
BEGIN
TheCell.Attr := ODP^.Attr;
For Z:=1 to ODP^.Size Do
BEGIN
TheCell.Char := PCharBuff( ODP^.Buff )^[Z];
VioWrtCellStr( @TheCell,
2,
ODP^.Y1+Z-2,
Pred( ODP^.X1 ),
0 );
END; { For Z }
END; { With AS^ }
END; { ODF_WriteVertAt }
{----}
ODF_ClrEOL:
BEGIN
With AS^ DO
BEGIN
TheCell.Char := ' ';
TheCell.Attr := CurAttr;
VioWrtNCell( @TheCell,
Pred(WinX2-CurX), {count}
CurY,
CurX,
0 );
END; { With AS^ }
END; { ODF_ClrEOL }
{----}
ODF_ClrScr:
BEGIN
With AS^ DO
BEGIN
{ scroll the entire region off }
RegionScroll( WinX1, WinY1,
WInX2, WinY2,
0-Succ(WInY2-WinY1) );
CurX := WinX1;
CurY := WinY1;
RealCursorGoto( IData^.Ascreen-1, CurX, Cury );
END; { With AS^ }
END; { ODF_ClrScr }
{----}
ODF_DelLine:
BEGIN
With AS^ Do
BEGIN
RegionScroll( WinX1,
CurY,
WinX2,
WinY2,
-1 );
{ Cursor to WinX1?? }
END; { With AS^ }
END; { ODF_DelLine }
{----}
ODF_InsLine:
BEGIN
With AS^ Do
BEGIN
RegionScroll( WinX1,
CurY,
WinX2,
WinY2,
1 );
{ Cursor to WinX1?? }
END; { With AS^ }
END; { ODF_InsLine }
{----}
ODF_GotoXY:
BEGIN
With AS^Do
BEGIN
CurX := WinX1+(ODP^.X1-1);
CurY := WinY1+(ODP^.Y1-1);
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { With AS^ }
END; { ODF_GotoXY }
{----}
ODF_Window:
BEGIN
With AS^ Do
BEGIN
WinX1 := ODP^.X1-1;
WinY1 := ODP^.Y1-1;
WinX2 := ODP^.X2-1;
WinY2 := ODP^.Y2-1;
If WinX2<WinX1 Then SwapCoords( WinX1, WinX2 );
If WinY2<WinY1 Then SwapCoords( WinY1, WinY2 );
CurX := WinX1;
CurY := WinY1;
RealCursorGoto( IData^.Ascreen-1, CurX, Cury );
{ call visionix services to set window coords }
END; { With AS^ }
END; { ODF_Window }
{----}
{ 7 6 5 4 3 2 1 0 }
{ F B B B T T T T }
ODF_ColorText:
BEGIN
With AS^ Do
BEGIN
CurAttr := (CurAttr AND $F0) + (ODP^.TheColor AND $0F);
END; { With AS^ }
END; { ODF_ColorText }
{----}
ODF_ColorBack:
BEGIN
With AS^ Do
BEGIN
CurAttr := (CurAttr AND $0F) + ((ODP^.TheColor AND $07) SHL 4);
END; { With AS^ }
END; { ODF_ColorBack }
{----}
ODF_GetWin:
BEGIN
With AS^ Do
BEGIN
ODP^.X1 := WinX1+1;
ODP^.Y1 := WinY1+1;
ODP^.X2 := WinX2+1;
ODP^.Y2 := WinY2+1;
ODP^.Status := ODS_Changed;
END; { With AS^ }
END; { ODF_GetWin }
{----}
ODF_GetAttr:
BEGIN
ODP^.Attr := AS^.CurAttr;
ODP^.Status := ODS_Changed;
END; { ODF_GetAttr }
{----}
ODF_SetAttr:
BEGIN
AS^.CurAttr := ODP^.Attr;
END; { ODF_SetAttr }
{----}
ODF_GetXY:
BEGIN
ODP^.X1 := (AS^.CurX+1)-AS^.WinX1;
ODP^.Y1 := (AS^.CurY+1)-AS^.WinY1;
ODP^.Status := ODS_Changed;
END; { ODF_GetXY }
{----}
ODF_GetNumScreens:
BEGIN
ODP^.Screens := IData^.NumScreens;
ODP^.Status := ODS_Changed;
END; { ODF_GetNumScreens }
{----}
ODF_GoScreen:
BEGIN
If ODP^.Screens <= IData^.NumScreens Then
IData^.AScreen := ODP^.Screens;
END; { ODF_GoScreen }
{----}
ODF_SetCursorType:
BEGIN
MySetCursorType( ODP^.NumVal );
AS^.CurType := ODP^.NumVal;
END; { ODF_SetCursorType }
{----}
ODF_DrawVLine:
BEGIN
END; { ODF_DrawVLine }
{----}
ODF_DrawHLine:
BEGIN
END; { ODF_DrawHLine }
{----}
ODF_DrawBox:
BEGIN
END; { ODF_DrawBox }
{----}
ODF_ReadChar:
BEGIN
ODP^.CH := AS^.S^[ (Pred(ODP^.Y1)*YMult)+Pred(ODP^.X1) ].Char;
ODP^.Status := ODS_Changed;
END; { ODF_ReadChar }
{----}
ODF_ReadAttr:
BEGIN
ODP^.Attr := AS^.S^[ (Pred(ODP^.Y1)*YMult)+ODP^.X1-1 ].Attr;
ODP^.Status := ODS_Changed;
END; { ODF_ReadAttr }
{----}
ODF_WriteAttr:
BEGIN
VioWrtNAttr( @ODP^.Attr,
1,
Pred(ODP^.Y1),
Pred(ODP^.X1),
0 );
END; { ODF_WriteAttr }
{----}
ODF_QueryRegion:
BEGIN
ODP^.RegionSize := ((ODP^.Y2-ODP^.Y1)+1)*((ODP^.X2-ODP^.X1)+1)*2;
ODP^.Status := ODS_Changed;
END; { ODF_QueryRegion }
{----}
ODF_ReadRegion:
BEGIN
If ODP^.Status AND ODS_Changed=0 Then
RegionRead( Pred(ODP^.X1), Pred(ODP^.Y1),
Pred(ODP^.X2), Pred(ODP^.Y2), ODP^.Region );
ODP^.Status := ODS_Changed;
END; { ODF_ReadRegion }
{----}
ODF_WriteRegion:
BEGIN
RegionWrite( ODP^.X1-1, ODP^.Y1-1,
ODP^.X2-1, ODP^.Y2-1, ODP^.Region );
END; { ODF_WriteRegion }
{----}
ODF_DriverRenew:
BEGIN
END; { ODF_DriverRenew }
{----}
ODF_CursorUp:
BEGIN
With AS^Do
BEGIN
(*
If (CurY-ODP^.Numval) >= WinY1 Then
Dec( CurY, ODP^.NumVal )
Else
CurY := WinY1;
*)
For Z:=1 to ODP^.NumVal Do
If CurY>WinY1 Then
Dec(CurY);
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { With AS^ }
END; { ODF_CursorUp }
{----}
ODF_CursorDown:
BEGIN
With AS^Do
BEGIN
(*
If (CurY+ODP^.Numval) <= WinY2 Then
Inc( CurY, ODP^.NumVal )
Else
CurY := WinY2;
*)
For Z:=1 to ODP^.NumVal Do
If CurY<WinY2 Then
Inc(CurY);
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { With AS^ }
END; { ODF_CursorDown }
{----}
ODF_CursorLeft:
BEGIN
With AS^ Do
BEGIN
(*
If (CurX-ODP^.Numval) >= WinX1 Then
Dec( CurY, ODP^.NumVal )
Else
CurX := WinX1;
*)
For Z:=1 to ODP^.Numval Do
If CurX>WinX1 Then
Dec(CurX);
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { With AS^ }
END; { ODF_CursorLeft }
{----}
ODF_CursorRight:
BEGIN
With AS^Do
BEGIN
(*
If (CurX+ODP^.NumVal) <= WinX2 Then
Inc( CurX, ODP^.NumVal )
Else
CurY := WinX2;
*)
For Z:=1 to ODP^.Numval Do
If CurX<WinX2 Then
Inc(CurX);
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { With AS^ }
END; { ODF_CursorRight }
{----}
ODF_RegionScrUp:
BEGIN
RegionScroll( Pred(ODP^.X1), Pred(ODP^.Y1),
Pred(ODP^.X2), Pred(ODP^.Y2),
0-ODP^.NumVal );
END; { ODF_RegionScrUp }
{----}
ODF_RegionScrDown:
BEGIN
RegionScroll( Pred(ODP^.X1), Pred(ODP^.Y1),
Pred(ODP^.X2), Pred(ODP^.Y2),
ODP^.NumVal );
END; { ODF_RegionScrDown }
{----}
ODF_RegionCopy:
BEGIN
END; { ODF_RegionCopy }
{----}
ODF_RegionFill:
BEGIN
With AS^ DO
BEGIN
TheCell.Char := ODP^.Ch;
TheCell.Attr := ODP^.Attr;
Z := Succ(ODP^.Y2-ODP^.Y1);
For Z2:=Pred(ODP^.Y1) to Pred(ODP^.Y2) Do
BEGIN
VioWrtNCell( @TheCell,
Z,
Z2,
Pred(ODP^.X1),
0 );
END; { For Z2 (y) }
END; { With AS^ }
END; { ODF_RegionFill }
{----}
ODF_RegionFillA:
BEGIN
With AS^ DO
BEGIN
Z := Succ(ODP^.Y2-ODP^.Y1);
For Z2:=Pred(ODP^.Y1) to Pred(ODP^.Y2) Do
BEGIN
VioWrtNAttr( @ODP^.Attr,
Z,
Z2,
Pred(ODP^.X1),
0 );
END; { For Z2 (y) }
END; { With AS^ }
END; { ODF_RegionFillA }
{----}
ODF_RegionFillC:
BEGIN
With AS^ DO
BEGIN
Z := Succ(ODP^.Y2-ODP^.Y1);
For Z2:=Pred(ODP^.Y1) to Pred(ODP^.Y2) Do
BEGIN
VioWrtNChar( @ODP^.CH,
Z,
Z2,
Pred(ODP^.X1),
0 );
END; { For Z2 (y) }
END; { With AS^ }
END; { ODF_RegionFillC }
{----}
ODF_RepeatChar:
BEGIN
With AS^ Do
BEGIN
IF (ODP^.CH<>#13) and (ODP^.CH<>#10) Then
BEGIN
TheCell.Char := ODP^.Ch;
TheCell.Attr := CurAttr;
For Z:=1 to ODP^.NumVal Do
BEGIN
VioWrtCellStr( @TheCell,
2,
CurY,
CurX,
0 );
CursorNextChar( FALSE );
END; { For Z }
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { If ODP^.Ch }
END; { With AS^ }
END; { ODF_RepeatChar }
{----}
ODF_RepeatCharAt:
BEGIN
With AS^ DO
BEGIN
TheCell.Char := ODP^.CH;
TheCell.Attr := ODP^.Attr;
VioWrtNCell( @TheCell,
ODP^.NumVal,
Pred(ODP^.Y1),
Pred(ODP^.X1),
0 );
END; { With AS^ }
END; { ODF_RepeatCharAt }
{----}
ODF_GetScreenSize:
BEGIN
With AS^ Do
BEGIN
ODP^.X1 := IData^.Cols;
ODP^.Y1 := Idata^.Rows;
END; { With AS^ }
END; { ODF_GetScreenSize }
{----}
ODF_RepeatBlock:
BEGIN
With AS^ DO
BEGIN
Z3 := ODP^.Start;
TheCell.Attr := CurAttr;
For Z2:=1 to ODP^.NumVal Do
BEGIN
For Z:=Z3 to ODP^.Size Do
BEGIN
Case PCharBuff( ODP^.Buff)^[Z] Of
#13:
BEGIN
CurX := WinX1;
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { #13 }
#10:
BEGIN
CursorDown( TRUE );
END;
Else
TheCell.Char := PCharBuff( ODP^.Buff )^[Z];
VioWrtCellStr( @TheCell,
2,
CurY,
CurX,
0 );
CursorNextChar( FALSE );
END; { Case PCharBuff( ODP^.Buf)^[Z] }
END; { For Z }
Z3 := 1;
END; { for Z2 }
RealCursorGoto( IData^.Ascreen-1, CurX, CurY );
END; { With AS^ }
ODP^.Start := ODP^.Size;
END; { ODF_Repeatblock }
{----}
{----}
Else { Else Case }
END; { Case ODP^.Func }
END; { If ODP^.Status = 0 }
CallNextDriver( ODP );
END; { VIOOutDriverProc }
{$ENDIF}
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CRTVGASetCharWidth( CWid : BYTE );
[PARAMETERS]
CWid Desired New Character Width
[RETURNS]
(None)
[DESCRIPTION]
Sets the VGA Character Width to a given pixel Width.
Sets the text mode character width of a vga display. normally,
a character in vga mode is 9 pixels wide. However, the font
tables only have 8 chars per pixel. This is a problem when
characters need to "touch" each other.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CRTVGASetCharWidth( CWid : BYTE );
Var
{$IFNDEF OS2}
R : REGISTERS;
{$ENDIF}
B : BYTE;
BEGIN
{$IFDEF OS2}
{$ELSE}
If CWid in [8..9] Then
BEGIN
Case CWid Of
8 :
BEGIN
B := (Port[ $3CC ] and NOT(4+8));
R.BX := $0001;
END; { 8 }
9 :
BEGIN
B := (Port[ $3CC ] and NOT(4+8)) or 4;
R.BX := $0800;
END; { 9 }
END; { Case CWid }
Port[ $3C2 ] := B;
ASM CLI; END;
PortW[ $3C4 ] := $0100;
PortW[ $3C4 ] := $01 + R.BL SHL 8;
PortW[ $3C4 ] := $0300;
ASM STI; END;
R.AX := $1000;
R.BL := $13;
R.ES := $0;
R.DS := $0;
Intr( $10, R );
END; { If CWid }
{$ENDIF}
END; { CRTVGASetCharWidth }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CRTInDriverProc( IDP : PInDriverPacket );
[PARAMETERS]
IDP Pointer To In-Data Driver Packet
[RETURNS]
(None)
[DESCRIPTION]
This is THE Input CRT Driver Procedure. It handles all the Input
CRT Related Functions.
This is the in driver procedure which is placed on the
CRT in-channel
it takes VIN driver requests and performs them on the
keyboard
See VIN for more information
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CRTInDriverProc( IDP : PInDriverPacket );
Type
TDefKdInstanceData = Record
KeyBuff : PString;
Off : WORD;
Name : TProcName;
ExtKeyChar : CHAR;
END;
PDefKDInstanceData = ^TDefKDInstanceData;
Var
IData : PDefKDInstanceData;
KeyW : WORD;
{────────────────────────────────────────────────────────────────────────}
Function MyKeyPressed : BOOLEAN;
{$IFNDEF OS2}
Var
R : REGISTERS;
BEGIN
MyKeyPressed := BiosMemMap^.KbdBufHead<>BiosMemMap^.KbdBufTail;
END; { MyKeyPressed }
{$ELSE}
Var
KeyInfo : TKbdKeyInfo;
BEGIN
KbdPeek(KeyInfo,0);
MyKeyPressed := ((KeyInfo.fbStatus AND $40) <> 0);
(*
MyKeyPressed := (IData^.ExtKeyChar <> #0 ) or
( (KeyInfo.fbStatus And $40) <> 0);
*)
END; { MyKeyPressed }
{$ENDIF}
{────────────────────────────────────────────────────────────────────────}
Function MyReadKey : WORD;
{$IFNDEF OS2}
Var
R : REGISTERS;
BEGIN
R.AH := $00;
R.ES := $00;
R.DS := $00;
Intr( $16, R );
MyReadKey := R.AX;
END; { MyReadKey }
{$ELSE}
Var
KeyInfo : TKbdKeyInfo;
W : WORD;
BEGIN
KbdCharIn( KeyInfo, 0, 0 );
W := ( Byte(KeyInfo.chscan) SHL 8) + Byte(KeyInfo.ChChar);
MyReadKey := W;
(*
If IData^.ExtKeyChar <> #0 Then
BEGIN
MyReadKey := Idata^.ExtKeyChar;
IData^.ExtKeyChar := #0;
END
ELSE
BEGIN
KbdCharIn( KeyInfo, 0, 0 );
If KeyInfo.chChar = #0 Then
ExtKeyChar := KeyInfo.chScan;
MyReadKey := KeyInfo.chChar;
END;
*)
END;
{$ENDIF}
{────────────────────────────────────────────────────────────────────────}
BEGIN { CRTInDriverProc }
IData := IDP^.ID;
If IDP^.Status = 0 Then
BEGIN
Case IDP^.Func Of
IDF_DriverNew:
BEGIN
IF @IDP^.InDriverProc = @CRTInDriverProc Then
BEGIN
New( Idata );
IData^.Name := IDP^.Name^;
IData^.KeyBuff := IDP^.SysKeyBuff;
IData^.Off := 0;
IDP^.Status := IDS_Install+IDS_Changed;
IDP^.ID := IData;
END; { If @IDP^.InDriverProc }
END; { IDF_DriverNew }
{----}
IDF_DriverOff:
BEGIN
If IDP^.Name^ = IData^.Name Then
BEGIN
Inc( Idata^.Off );
END; { IDP^.Name^ }
END; { IDF_DriverOff }
{----}
IDF_DriverOn:
BEGIN
If IDP^.Name^ = IData^.Name Then
BEGIN
If Idata^.Off <> 0 Then
Dec( Idata^.Off );
END; { If IDP^.Name^ }
END; { IDF_DriverOn }
{----}
IDF_DriverDispose:
BEGIN
If IDP^.Name^ = IData^.Name Then
BEGIN
{RemoveFromInDriverStack }
Dispose( IData );
END; { If IDP^.Name^ }
END; { IDF_DriverDispose }
{----}
IDF_Look:
If IData^.Off=0 Then
BEGIN
If Idata^.KeyBuff^<>'' Then
BEGIN
IDP^.Key := IData^.KeyBuff^[1];
IDP^.Status := IDS_Changed;
END { If IData^.KeyBuff^ }
Else
BEGIN
If MyKeyPressed Then
BEGIN
KeyW := MyReadKey;
IDP^.Key := Char(Lo(Keyw));
If Lo(KeyW)=0 Then
IData^.KeyBuff^ := IData^.KeyBuff ^ + Char(Lo(Keyw)) +
Char(Hi(KeyW)) ;
IDP^.Status := IDS_Changed;
END; { If MyKeyPressed }
END; { If IData^.KeyBuff^ / Else }
END; { IDF_Look }
{----}
IDF_Read:
If IData^.Off=0 Then
BEGIN
If IData^.KeyBuff^<>'' Then
BEGIN
IDP^.Key := IData^.KeyBuff^[1];
Delete( IData^.KeyBuff^, 1, 1 );
IDP^.Status := IDS_Changed;
If IDP^.Key=#0 Then
IDP^.Status := IDP^.Status + IDS_Sequence;
END { If IData^.KeyBuff^ }
Else
BEGIN
If MyKeyPressed Then
BEGIN
KeyW := MyReadKey;
IDP^.Key := Char(Lo(KeyW));
If Lo(Keyw)=0 Then
IData^.KeyBuff^ := IData^.KeyBuff ^ + Char(Hi(Keyw));
IDP^.Status := IDS_Changed;
If IDP^.Key = #0 Then
IDP^.Status := IDP^.Status + IDS_Sequence;
END; { If MyKeyPressed }
END; { If IData^.KeyBuff^ / Else }
END; { IDF_Read }
{----}
IDF_Write:
BEGIN
IData^.KeyBuff^ := IData^.KeyBuff^ + IDP^.KeysToWrite^;
IDP^.Status := IDS_Changed;
END; { IDF_Write }
{----}
IDF_State:
BEGIN
{ Read Shift/Ctrl/Alt State }
END; { IDF_State }
{----}
IDF_Flush:
IF IData^.Off=0 Then
BEGIN
IData^.KeyBuff^ := '';
While MyKeyPressed DO
MyReadKey;
(*
IData^.KeyBuff^ := '';
BiosMemMap^.KbdBufTail := BiosMemMap^.KbdBufHead;
*)
IDP^.Status := IDS_Changed;
END; { If IData^.Off }
{ IDF_Flush }
{----}
IDF_Pressed:
IF (IData^.Off=0) and (IDP^.Pressed=FALSE) Then
BEGIN
IDP^.Pressed := ( MyKeyPressed ) Or ( IData^.KeyBuff^[0]<>#0 );
If IDP^.Pressed=TRUE Then
IDP^.Status := IDS_Changed;
END; { If IData^.Off }
Else { Case Else }
END; { Case IDP^.Func }
END; { If IDP^.Status = 0 }
END; { CRTInDriverProc }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure SyncAttr;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
Syncs the CRT out-channel with the current TextAttr setting should only
need to be done when it is beleived that a driver on the CRT out-channel
is "lost", and this should only happen when serial-port out-channel
drivers are put on the crt out-channel
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure SyncAttr;
BEGIN
TextAttrSet( TextAttr );
END;
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure SyncWind;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
Syncs the CRT out-channel with the current window setting should only
need to be done when it is beleived that a driver on the CRT out-channel
is "lost", and this should only happen when serial-port out-channel
drivers are put on the crt out-channel
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure SyncWind;
BEGIN
Window( Lo(WindMin)+1, Hi(WindMin)+1,
Lo(WindMax)+1, Hi(WindMax)+1 );
END;
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function CRTTextNullProc( Var F : TextRec ) : INTEGER; Far;
[PARAMETERS]
F VAR Text File Record (?)
[RETURNS]
[DESCRIPTION]
[SEE-ALSO]
[EXAMPLE]
-*)
Function CRTTextNullProc( Var F : TextRec ) : INTEGER; Far;
BEGIN
END; { CRTTextNullProc }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function CRTTextOutProc( Var F : TextRec ) : INTEGER; Far;
[PARAMETERS]
F VAR ?
[RETURNS]
[DESCRIPTION]
[SEE-ALSO]
[EXAMPLE]
-*)
Function CRTTextOutProc( Var F : TextRec ) : INTEGER; Far;
BEGIN
If TextAttr<>KnownTextAttr Then
SyncAttr;
If (WindMin<>KnownWindMin) or (WindMax<>KnownWindMax) Then
SyncWind;
If F.BufPos <> 0 Then
VOutWriteBlock( CrtOCH, F.BufPtr, F.BufPos );
F.BufPos := 0;
CRTTextOutProc := 0;
END; { CRTTextOutProc }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function CRTTextInProc( Var F : TextRec ) : INTEGER; Far;
[PARAMETERS]
F VAR Handle to File Text Record
[RETURNS]
[DESCRIPTION]
[SEE-ALSO]
[EXAMPLE]
-*)
Function CRTTextInProc( Var F : TextRec ) : INTEGER; Far;
BEGIN
CRTTextInProc := 1;
END; { CRTTextInProc }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function CRTTextOpenProc( Var F : TextRec ) : INTEGER; Far;
[PARAMETERS]
F VAR ?
[RETURNS]
[DESCRIPTION]
[SEE-ALSO]
[EXAMPLE]
-*)
Function CRTTextOpenProc( Var F : TextRec ) : INTEGER; Far;
BEGIN
With F Do
BEGIN
If Mode <> fmInput Then
BEGIN
Mode := fmOutput;
FlushFunc := @CRTTextOutProc;
CloseFunc := @CRTTextNullProc;
InOutFunc := @CRTTextOutProc;
END { If Mode }
Else
BEGIN
FlushFunc := @CRTTextNullProc;
CloseFunc := @CRTTextNullProc;
InOutFunc := @CRTTextInProc;
END; { If Mode <> fmInput / ELSE }
END; { With F }
CRTTextOpenProc := 0;
END; { CRTTextOpenProc }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure AssignCRT( Var F : Text );
[PARAMETERS]
F VAR Output File Handle (The Screen)
[RETURNS]
(None)
[DESCRIPTION]
Assigns a text-file to the CRT.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure AssignCRT( Var F : Text );
BEGIN
With TextRec( F ) DO
BEGIN
BufSize := 128;
BufPtr := @Buffer;
OpenFunc := @CRTTextOpenProc;
BufPos := 0;
Handle := 0;
END; { With TextRec( F ) }
END; { AssignCRT }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure ClrEOL;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
Clears a Line using the Current Color Attributes from the current
Cursor Position to the End of the Screen. If we are within a Window,
then the action is restricted to within this Window.
Clears to the end of the line from the current cursor position.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure ClrEOL;
BEGIN
If TextAttr<>KnownTextAttr Then
SyncAttr;
If (WindMin<>KnownWindMin) or (WindMax<>KnownWindMax) Then
SyncWind;
VOutClrEOL( CrtOCH );
END; { ClrEOL }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure ClrScr;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
Clears the Screen by filling it with Spaces using the current color
attributes. If we are within a Window then the Clear Screen is
restricted to just within this Window.
Clears the screen or the active window.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure ClrScr;
BEGIN
If TextAttr<>KnownTextAttr Then
SyncAttr;
If (WindMin<>KnownWindMin) or (WindMax<>KnownWindMax) Then
SyncWind;
VOutClrScr( CrtOCH );
END; { ClrScr }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure DelayOneMS;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
Delays activity for a Single Millisecond, then resumes.
[SEE-ALSO]
[EXAMPLE]
-*)
{$IFNDEF OS2}
Procedure DelayOneMS;
Assembler;
ASM
PUSH CX
MOV CX, DelayOfMS
@1:
LOOP @1
POP CX
END; { DelayOneMS }
{$ENDIF}
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure Delay( MS : WORD );
[PARAMETERS]
MS Number of Milliseconds Delay
[RETURNS]
(None)
[DESCRIPTION]
Delays activity for a given number of Milliseconds, then Resumes.
Delays for the specified number of milliseconds.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure Delay( MS : WORD );
{$IFNDEF OS2}
Assembler;
ASM
MOV CX, ms
JCXZ @2
@1:
CALL DelayOneMS
LOOP @1
@2:
END; { Delay }
{$ELSE}
BEGIN
DosSleep( MS );
END;
{$ENDIF}
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure FindDelay;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
Determines the proper Time Delay Rate for this computer based upon how
long it takes to execute a given delay.
[SEE-ALSO]
[EXAMPLE]
-*)
{$IFNDEF OS2}
Procedure FindDelay;
Assembler;
ASM
MOV DelayOfMS, 55
MOV AX, Seg0040
MOV ES, AX
MOV DI, 6Ch
XOR DX, DX
MOV AX, ES:[DI]
@1:
CMP AX, ES:[DI]
JE @1
MOV AX, ES:[DI]
@2:
CALL DelayOneMs
INC DX
CMP AX, ES:[DI]
JE @2
MOV DelayOfMS, DX
END;
{$ENDIF}
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure DelLine;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
Deletes a Line at the Current Cursor Position. If we are in a Window,
then the Deleted Line is just within this window.
Deletes the line that the cursor is currently on. All lines
in the active window below the cursor will scroll up.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure DelLine;
BEGIN
If TextAttr<>KnownTextAttr Then
SyncAttr;
If (WindMin<>KnownWindMin) or (WindMax<>KnownWindMax) Then
SyncWind;
VOutDelLine( CrtOCH );
END; { DelLine }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure GotoXY( X : BYTE;
Y : BYTE );
[PARAMETERS]
X X Screen Coordinate
Y Y Screen Coordinate
[RETURNS]
(None)
[DESCRIPTION]
Moves the Cursor to the provided Screen Coordinates (Relative to any
active Window.
Hey, look. Check out the normal CRT unit info for the rest
of these. We'll fill them in soon.
We'll continue the comments with the other functions below
that are extensions to the normal CRT API.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure GotoXY( X : BYTE;
Y : BYTE );
BEGIN
If (WindMin<>KnownWindMin) or (WindMax<>KnownWindMax) Then
SyncWind;
VOutGotoXY( CrtOCH, X,Y );
END; { GotoXY }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure HighVideo;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
Sets the Vidio Intensity output to it's Highest Level.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure HighVideo;
BEGIN
If TextAttr<>KnownTextAttr Then
SyncAttr;
{ Set attribute }
END; { HighVideo }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure InsLine;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
Inserts a Blank Line of the current Color Attributes at the Current
Cursor Position. It we are in a Window, then the inserted Line is
just within this Window.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure InsLine;
BEGIN
If (WindMin<>KnownWindMin) or (WindMax<>KnownWindMax) Then
SyncWind;
If TextAttr<>KnownTextAttr Then
SyncAttr;
VOutInsLine( CrtOCH );
END; { InsLine }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function KeyPressed : BOOLEAN;
[PARAMETERS]
(None)
[RETURNS]
Whether the Keyboard has been press since the last it was Read
[DESCRIPTION]
Determines if a Character is in the Keyboard Buffer and if so,
reports that ther is (TRUE). If there isn't then the report
isn't (FALSE).
[SEE-ALSO]
[EXAMPLE]
-*)
Function KeyPressed : BOOLEAN;
BEGIN
KeyPressed := VInPressed;
END; { KeyPressed }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure LowVideo;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
Sets the Vidio Intensity output to it's Lowest Level.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure LowVideo;
BEGIN
If TextAttr<>KnownTextAttr Then
SyncAttr;
{ Set attribute }
END; { LowVideo }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure NormVideo;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
Resets the Video Intensity output to the Normal Level.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure NormVideo;
BEGIN
If TextAttr<>KnownTextAttr Then
SyncAttr;
END; { NormVideo }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure NoSound;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
Turns off any audio output from the Speaker.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure NoSound;
Assembler;
ASM
IN AL, $61
AND AL, $FC
OUT $61, AL
END; { NoSound }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function ReadKey : CHAR;
[PARAMETERS]
(None)
[RETURNS]
1st available Character Read from the Keyboard
[DESCRIPTION]
Reads a Key from the keyboard and returns the 1st Character Read.
[SEE-ALSO]
[EXAMPLE]
-*)
Function ReadKey : CHAR;
BEGIN
ReadKey := VInRead;
END; { ReadKey }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure Sound( Hz : WORD );
[PARAMETERS]
Hz Desired Audio Frequency in Hertz
[RETURNS]
(None)
[DESCRIPTION]
Outputs a sound thru the speaker at the provided Frequency.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure Sound( Hz : WORD );
Assembler;
ASM
MOV BX, Hz
MOV AX, 34DDh
MOV DX, 0012h
CMP DX, BX
JNC @2
DIV BX
MOV BX, AX
IN AL, 61h
TEST AL, 3
JNZ @1
OR AL, 3
OUT 61h, AL
MOV AL, 0B6h
OUT 43H, AL
@1:
MOV AL, BL
OUT 42h, AL
MOV AL, BH
OUT 42H, AL
@2:
END; { Sound }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure TextBackGround( Color : BYTE );
[PARAMETERS]
Color New Text Background Color
[RETURNS]
(None)
[DESCRIPTION]
Sets the New Active Text Background Color
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure TextBackGround( Color : BYTE );
BEGIN
{ may need to syncattr }
VOutTextBackGround( CrtOCH, Color AND $07 );
TextAttrSet( (TextAttr AND $8F) + ((Color AND $07) SHL 4) );
END; { TextBackGround }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure TextColor( Color : BYTE );
[PARAMETERS]
Color New Text Foreground Color
[RETURNS]
(None)
[DESCRIPTION]
Sets the New Active Text Foreground Color
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure TextColor( Color : BYTE );
BEGIN
{ may need to sync attr }
VOutTextColor( CrtOCH, Color );
TextAttrSet( (TextAttr and $F0) + ((Color and $0F)) );
END; { TextColor }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure TextMode( Mode : INTEGER );
[PARAMETERS]
Mode Desired CRT Vidio Mode
[RETURNS]
(None)
[DESCRIPTION]
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure TextMode( Mode : INTEGER );
BEGIN
{ set text mode }
END; { TextMode }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function WhereX : BYTE;
[PARAMETERS]
(None)
[RETURNS]
The Current X Cursor Position
[DESCRIPTION]
Determines and returns the Current X Cursor Screen Coordinates.
[SEE-ALSO]
[EXAMPLE]
-*)
Function WhereX : BYTE;
BEGIN
WhereX := VOutWhereX( CrtOCH );
END; { Where X }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function WhereY : BYTE;
[PARAMETERS]
(None)
[RETURNS]
The Current Y Cursor Position
[DESCRIPTION]
Determines and returns the Current Y Cursor Screen Coordinates.
[SEE-ALSO]
[EXAMPLE]
-*)
Function WhereY : BYTE;
BEGIN
WhereY := VOutWhereY( CrtOCH );
END; { WhereY }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure Window( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE );
[PARAMETERS]
X1 Left Window Coordinate
Y1 Top Window Coordinate
X2 Right Window Coordinate
Y2 Bottom Window Coordinate
[RETURNS]
(None)
[DESCRIPTION]
Establishes a Window with the provided Coordinates.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure Window( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE );
BEGIN
VOutWindow( CrtOCH, X1, Y1, X2, Y2 );
WindMin := ((Y1-1) SHL 8) + (X1-1);
WindMax := ((Y2-1) SHL 8) + (X2-1);
KnownWindMin := WindMin;
KnownWindMax := WindMax;
WindCenterCol := X1 + ((X2-X1) DIV 2);
WindCenterRow := Y1 + ((Y2-Y1) DIV 2);
END; { Window }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure WindowScreen;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
Restores the Window Size as that of the Entire Screen.
Sets the active window size to be the entire screen.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure WindowScreen;
BEGIN
VOutWindow( CrtOCH, 1,1,ScreenCols,ScreenRows );
END; { WindowScreen }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function TextColorGet : BYTE;
[PARAMETERS]
(None)
[RETURNS]
The Current Foreground Attribute Color
[DESCRIPTION]
Returns the Current Foreground Color from the CRT Attribute Value.
Gets the current text color. IT IS PREFERED TO USE THIS
INSTEAD OF JUST LOOKING AT THE TEXTATTR VARIABLE.
[SEE-ALSO]
[EXAMPLE]
-*)
Function TextColorGet : BYTE;
BEGIN
TextColorGet := TextAttr AND $0F;
END; { TextColorGet }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function TextBackgroundGet : BYTE;
[PARAMETERS]
(None)
[RETURNS]
The Current Background Attribute Color
[DESCRIPTION]
Returns the Current Background Color from the CRT Attribute
Value.
Gets the current text background. see note on TextColorGet.
[SEE-ALSO]
[EXAMPLE]
-*)
Function TextBackgroundGet : BYTE;
BEGIN
TextBackGroundGet := (TextAttr AND $70) SHR 4;
END; { TextBackgroundGet }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure TextColors( Fore : BYTE;
Back : BYTE );
[PARAMETERS]
fore foreground color to use
back background color to use
[RETURNS]
(None)
[DESCRIPTION]
Sets the Current CRT Attribute to the foreground and background
colors provided.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure TextColors( Fore : BYTE;
Back : BYTE );
BEGIN
TextColor( Fore );
TextBackGround( Back );
END;
(*-
[FUNCTION]
Procedure TextAttrSet( Attr : BYTE );
[PARAMETERS]
Attr New Attribute
[RETURNS]
(None)
[DESCRIPTION]
Sets the Current CRT Attribute to the Attribute Provided.
Sets the current TextAttr. IT IS PREFERED THAT ONE USE THIS
INSTEAD OF DIRECTLY CHANGING THE TEXTATTR VARIABLE.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure TextAttrSet( Attr : BYTE );
BEGIN
VOutTextAttrSet( CrtOCH, CRTColorMap[ Attr ] );
KnownTextAttr := CRTColorMap[ Attr ];
TextAttr := KnownTextAttr;
END; { TextAttrSet }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure GotoX( X : BYTE );
[PARAMETERS]
X column to go to
[RETURNS]
(None)
[DESCRIPTION]
Moves the Cursor the specifed column on the current line.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure GotoX( X : BYTE );
BEGIN
GotoXY( X, WhereY );
END;
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure GotoY( Y : BYTE );
[PARAMETERS]
X row/line to go to
[RETURNS]
(None)
[DESCRIPTION]
Moves the Cursor the specifed row/line on the in the current column.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure GotoY( Y : BYTE );
BEGIN
GotoXY( WhereX, Y );
END;
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CursorUp( Count : BYTE );
[PARAMETERS]
Count Number of Lines to Move Up
[RETURNS]
(None)
[DESCRIPTION]
Moves the Cursor Up by a given number of Lines.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CursorUp( Count : BYTE );
BEGIN
VOutCursorUp( CrtOCH, Count );
END; { CursorUp }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CursorDown( Count : BYTE );
[PARAMETERS]
Count Number of Lines to Move Down
[RETURNS]
(None)
[DESCRIPTION]
Moves the Cursor Down by a given number of Lines.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CursorDown( Count : BYTE );
BEGIN
VOutCursorDown( CrtOCH, Count );
END; { CursorDown }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CursorLeft( Count : BYTE );
[PARAMETERS]
Count Number of Places to Space Left
[RETURNS]
(None)
[DESCRIPTION]
Moves the Cursor Left by a given number of Places.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CursorLeft( Count : BYTE );
BEGIN
VOutCursorLeft( CrtOCH, Count );
END; { CursorLeft }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CursorRight( Count : BYTE );
[PARAMETERS]
Count Number of Places to Spaces Right
[RETURNS]
(None)
[DESCRIPTION]
Moves the Cursor Right by a given number of Places.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CursorRight( Count : BYTE );
BEGIN
VOutCursorRight( CrtOCH, Count );
END; { CursorRight }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function CharRead( X1 : BYTE;
Y1 : BYTE ) : CHAR;
[PARAMETERS]
X1 X Screen Coordinate
Y1 Y Screen Coordinate
[RETURNS]
Character Read from the Screen Coordinates
[DESCRIPTION]
Reads a Character from the Screen at the provided Coordinates.
Reads a character from the display console. returns whatever
character is on the screen at the specified location.
[SEE-ALSO]
[EXAMPLE]
-*)
Function CharRead( X1 : BYTE;
Y1 : BYTE ) : CHAR;
BEGIN
CharRead := VOutCharRead( CrtOCH, X1,Y1 );
END; { CharRead }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function AttrRead( X1 : BYTE;
Y1 : BYTE ) : BYTE;
[PARAMETERS]
X1 X Screen Coordinate
Y1 Y Screen Coordinate
[RETURNS]
Attribute Read from the Screen Coordinates
[DESCRIPTION]
Reads an Attribute from the Screen at the provided Coordinates.
Reads a attribute from the display console. returns whatever
attribute is on the screen at the specified location.
[SEE-ALSO]
[EXAMPLE]
-*)
Function AttrRead( X1 : BYTE;
Y1 : BYTE ) : BYTE;
BEGIN
AttrRead := VOutAttrRead( CrtOCH, X1,Y1 );
END; { AttrRead }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure AttrWrite( X1 : BYTE;
Y1 : BYTE;
Attr : BYTE );
[PARAMETERS]
X1 X Screen Coordinate
Y1 Y Screen Coordinate
Attr Attribute to Write
[RETURNS]
(None)
[DESCRIPTION]
Writes a given Attribute at a provided Screen Coordinate.
Writes an attribute to the display console.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure AttrWrite( X1 : BYTE;
Y1 : BYTE;
Attr : BYTE );
BEGIN
VOutAttrWrite( CrtOCH, X1, Y1, Attr );
END; { AttrWrite }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function RegionMemQuery( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE ) : WORD;
[PARAMETERS]
X1 Left Region Coordinate
Y1 Top Region Coordinate
X2 Right Region Coordinate
Y2 Bottom Region Coordinate
[RETURNS]
Number of Bytes of Memory required to Store Region
[DESCRIPTION]
Calculates and returns the number of bytes required to store a
given Region.
Returns how many bytes of memory need to be allocated to store
the specified region of the display console.
[SEE-ALSO]
[EXAMPLE]
-*)
Function RegionMemQuery( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE ) : WORD;
BEGIN
RegionMemQuery := VOutQueryRegion( CrtOCH, x1,y1,x2,y2 );
END; { RegionMemQuery }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RegionScrollUp( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Count : BYTE );
[PARAMETERS]
X1 Left Screen Region Coordinate
Y1 Top Screen Region Coordinate
X2 Right Screen Region Coordinate
Y2 Bottom Screen Region Coordinate
Count Number of Lines to Scroll
[RETURNS]
(None)
[DESCRIPTION]
Scrolls the Designated Screen Region Up by a given number of Lines.
Returns how many bytes of memory need to be allocated to store
the specified region of the display console.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RegionScrollUp( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Count : BYTE );
BEGIN
END; { RegionScrollUp }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RegionScrollDown( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Count : BYTE );
[PARAMETERS]
X1 Left Screen Region Coordinate
Y1 Top Screen Region Coordinate
X2 Right Screen Region Coordinate
Y2 Bottom Screen Region Coordinate
Count Number of Lines to Scroll
[RETURNS]
(None)
[DESCRIPTION]
Scrolls the Designated Screen Region Down by a given number of Lines.
Scrolls the specified region down by "count" number of lines.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RegionScrollDown( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Count : BYTE );
BEGIN
END; { RegionScrollDown }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RegionRead( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Region : Pointer );
[PARAMETERS]
X1 Source Left Screen Region Coordinate
Y1 Source Top Screen Region Coordinate
X2 Source Right Region Screen Region Coordinate
Y2 Source Bottom Screen Region Coordinate
Region Pointer to Region Data Storage Area
[RETURNS]
(None)
[DESCRIPTION]
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RegionRead( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Region : Pointer );
BEGIN
VOutReadRegion( CrtOCH, X1,Y1,X2,Y2, Region );
END; { RegionRead }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RegionWrite( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Region : Pointer );
[PARAMETERS]
X1 Destination Left Screen Region Coordinate
Y1 Destination Top Screen Region Coordinate
X2 Destination Right Region Screen Region Coordinate
Y2 Destination Bottom Screen Region Coordinate
Region Pointer to Region Data
[RETURNS]
(None)
[DESCRIPTION]
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RegionWrite( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Region : Pointer );
BEGIN
VOutWriteRegion( CrtOCH, X1,Y1,X2,Y2, Region );
END; { RegionWrite }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RegionCopy( X1 : BYTE;
Y1 : BYTE
X2 : BYTE;
Y2 : BYTE;
ToX1 : BYTE;
ToY1 : BYTE );
[PARAMETERS]
X1 Source Left Screen Region Coordinate
Y1 Source Top Screen Region Coordinate
X2 Source Right Region Screen Region Coordinate
Y2 Source Bottom Screen Region Coordinate
ToX1 Destination Left Screen Region Coordinate
ToY1 Destination Top Screen Region Coordinate
[RETURNS]
[DESCRIPTION]
Writes a region store buffer to the specified screen locations.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RegionCopy( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
ToX1 : BYTE;
ToY1 : BYTE );
BEGIN
END;
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RegionFill( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Ch : CHAR;
F : BYTE;
B : BYTE );
[PARAMETERS]
X1 Left Screen Region Coordinate
Y1 Top Screen Region Coordinate
X2 Right Region Screen Region Coordinate
Y2 Bottom Screen Region Coordinate
Ch Character Pattern to Fill Region With
F Foreground Color to Fill Region With
B Background Color to Fill Region With
[RETURNS]
(None)
[DESCRIPTION]
Fills the specified region with the specified "Ch" aracter,
"F"oreground, and "B"ackground.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RegionFill( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Ch : CHAR;
F : BYTE;
B : BYTE );
BEGIN
VOutFillRegion( CrtOCH, X1, Y1, X2, Y2, ((B AND $07) shl 4) + F, CH );
END; { RegionFill }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RegionFillAttr( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Attr : BYTE );
[PARAMETERS]
X1 Left Screen Region Coordinate
Y1 Top Screen Region Coordinate
X2 Right Region Screen Region Coordinate
Y2 Bottom Screen Region Coordinate
Attr Color attribute to use
[RETURNS]
(None)
[DESCRIPTION]
Fills the specified region with the specified "attr"ibute
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RegionFillAttr( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Attr : BYTE );
BEGIN
VOutFillRegionAttr( CrtOCH, X1, Y1, X2, Y2, Attr );
END; { RegionFillAttr }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RegionFillColors( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
F : BYTE;
B : BYTE );
[PARAMETERS]
X1 Left Screen Region Coordinate
Y1 Top Screen Region Coordinate
X2 Right Region Screen Region Coordinate
Y2 Bottom Screen Region Coordinate
F Foreground Color to Fill Region With
B Background Color to Fill Region With
[RETURNS]
(None)
[DESCRIPTION]
Fills the specified region with the specified "F"oregound
and "B"ackground colors.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RegionFillColors( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
F : BYTE;
B : BYTE );
Var
X : Byte;
Y : Byte;
BEGIN
VOutFillRegionAttr( CrtOCH, X1, Y1, X2, Y2, ((B AND $07) shl 4) + F );
(*
For Y := Y1 TO Y2 DO
For X:= X1 TO X2 DO
VOutAttrWrite( CrtOCH, X,Y,(B shl 4) + F);
*)
END; { RegionFillAttr }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RegionFillChar( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Ch : CHAR );
[PARAMETERS]
X1 Left Screen Region Coordinate
Y1 Top Screen Region Coordinate
X2 Right Region Screen Region Coordinate
Y2 Bottom Screen Region Coordinate
Ch Character Pattern to Fill Region with
[RETURNS]
(None)
[DESCRIPTION]
Fills the specified region with the specified character.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RegionFillChar( X1 : BYTE;
Y1 : BYTE;
X2 : BYTE;
Y2 : BYTE;
Ch : CHAR );
BEGIN
VOutFillRegionChar( CrtOCH, X1, Y1, X2, Y2, CH );
END; { RegionFillChar }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RepeatChar( Ch : CHAR;
Num : WORD );
[PARAMETERS]
Ch Character to Write
Num Number of times to Write Character
[RETURNS]
(None)
[DESCRIPTION]
Writes a Character a repeated number of times starting at the current
cursor position using the current colors.
Repeats a "Ch"aracter a "Num"ber of times at the current Cursor
location in the current colors.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RepeatChar( Ch : CHAR;
Num : WORD );
BEGIN
While (Num > 0) Do
BEGIN
Write( CH );
Dec( Num );
END; { While Num }
END; { RepeatChar }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure RepeatCharAt( X1 : BYTE;
Y1 : BYTE;
F : BYTE;
B : BYTE;
Ch : CHAR;
Num : WORD );
[PARAMETERS]
X1 X Screen Coordinate
Y1 Y Screen Coordinate
F Foreground Color
B Background Color
Ch Character to Write
Num Number of Times to Write Character
[RETURNS]
(None)
[DESCRIPTION]
Writes a Character a repeated number of times starting at a given Coordinate
with the provided Colors.
Repeats a character the specified number of times at the specified
X/Y locations and with the specified colors.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure RepeatCharAt( X1 : BYTE;
Y1 : BYTE;
F : BYTE;
B : BYTE;
Ch : CHAR;
Num : WORD );
Var
SaveX, SaveY, SaveF, SaveB : BYTE;
BEGIN
SaveX := WhereX;
SaveY := WhereY;
SaveF := TextColorGet;
SaveB := TextBackgroundGet;
GotoXY( X1, Y1 );
TextColor( F );
TextBackGround( B );
RepeatChar( Ch, Num );
GotoXY( SaveX, SaveY );
TextColor( SaveF );
TextBackGround( SaveB );
END; { RepeatCharAt }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure WriteCharAt( X1 : BYTE;
Y1 : BYTE;
F : BYTE;
B : BYTE;
Ch : CHAR );
[PARAMETERS]
X1 X Screen Coordinate
Y1 Y Screen Coordinate
F Foreground Color
B Background Color
Ch Character to Write
[RETURNS]
(None)
[DESCRIPTION]
Writes a single Character at the given screen coordinates using a
provided colors.
Writes a specified "ch"aracter at a specified X/Y location in the
specified colors.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure WriteCharAt( X1 : BYTE;
Y1 : BYTE;
F : BYTE;
B : BYTE;
Ch : CHAR );
BEGIN
VOutWriteCharAt( CrtOCH, X1, Y1, F, B, Ch );
END; { WriteCharAt }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure WriteStringAt( X1 : BYTE;
Y1 : BYTE;
F : BYTE;
B : BYTE;
S : STRING );
[PARAMETERS]
X1 X Screen Coordinate
Y1 Y Screen Coordinate
F Foreground Color
B Background Color
S String to Write
[RETURNS]
(None)
[DESCRIPTION]
Writes a String at the given coordinates using the provided colors.
Writes a specified "S"tring at a specified X/Y location in the
specified colors. Same as a "FastWrite".
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure WriteStringAt( X1 : BYTE;
Y1 : BYTE;
F : BYTE;
B : BYTE;
S : STRING );
BEGIN
VOutWriteStringAt( CrtOCH, X1, Y1, F, B, S );
END; { WriteStringAt }
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure WriteRepeatString( RepCount : WORD;
S : STRING );
[PARAMETERS]
repcount number of times to repeat the string
s the string to write repeatedly
[RETURNS]
(None)
[DESCRIPTION]
Writes a String repeatedly, starting at the current cursor location,
and in the current attribute.
[SEE-ALSO]
[EXAMPLE]
WriteRepeatString( 3, 'Hey! ');
Would output:
Hey! Hey! Hey!
-*)
Procedure WriteRepeatString( RepCount : WORD;
S : STRING );
BEGIN
VOutRepeatString( CrtOCH, RepCount, S );
END;
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CursorType( CurType : WORD );
[PARAMETERS]
curtype cursor type to use, can be:
cctNone = 0; { no visible cursor }
cctSmall = 1; { "normal cursor" }
cctHalf = 2; { half-height cursor }
cctBig = 3; { Full-height "overwrite" cursor }
[RETURNS]
(None)
[DESCRIPTION]
Sets the visible cursor type.
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CursorType( CurType : WORD );
BEGIN
VOutSetCursorType( CrtOCH, CurType );
END;
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CursorOn;
[PARAMETERS]
[RETURNS]
(None)
[DESCRIPTION]
Sets the visible cursor type to ON (normal-two line cusor)
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CursorOn;
BEGIN
VOutSetCursorType( CrtOCH, cctSmall );
END;
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CursorOff;
[PARAMETERS]
[RETURNS]
(None)
[DESCRIPTION]
Sets the visible cursor type to OFF (no cursor)
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CursorOff;
BEGIN
VOutSetCursorType( CrtOCH, cctNone );
END;
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CursorSmall
[PARAMETERS]
[RETURNS]
(None)
[DESCRIPTION]
Sets the visible cursor type to SMALL (normal-two line cusor)
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CursorSmall;
BEGIN
VOutSetCursorType( CrtOCH, cctSmall );
END;
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CursorHalf;
[PARAMETERS]
[RETURNS]
(None)
[DESCRIPTION]
Sets the visible cursor type to HALF (half-height cusor)
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CursorHalf;
BEGIN
VOutSetCursorType( CrtOCH, cctHalf );
END;
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Procedure CursorBig;
[PARAMETERS]
[RETURNS]
(None)
[DESCRIPTION]
Sets the visible cursor type to BIG (full-height "overwrite" cursor )
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CursorBig;
BEGIN
VOutSetCursorType( CrtOCH, cctBig );
END;
{────────────────────────────────────────────────────────────────────────────}
(*-
[FUNCTION]
Function MakeAttr( F : INTEGER;
B : INTEGER ) : BYTE;
[PARAMETERS]
F foreground color to use (-1 to use current foreground)
B background color to use (-1 to use current background)
[RETURNS]
(None)
[DESCRIPTION]
This function makes an attribute byte from the specified foreground
and background colors. To use the current foreground color,
"F" should be -1. To use the current background color, "B" should
be -1.
[SEE-ALSO]
[EXAMPLE]
-*)
Function MakeAttr( F : INTEGER;
B : INTEGER ) : BYTE;
BEGIN
If F=-1 Then
F := TextAttr AND $0F;
If B=-1 Then
B := (TextAttr AND $80) SHR 4 ;
MakeAttr := ((B AND $7) SHL 4) + (F AND $0F);
END;
(*-
[FUNCTION]
Procedure CRTLoadDefColorMap;
[PARAMETERS]
(None)
[RETURNS]
(None)
[DESCRIPTION]
[SEE-ALSO]
[EXAMPLE]
-*)
Procedure CRTLoadColorMap( P : PCRTColorMap );
BEGIN
Move( P^, CRTColorMap, 256 );
END;
Procedure CRTLoadMonoColorMap;
BEGIN
CRTLoadColorMap( @MonoMap );
END;
Procedure CRTLoadDefColorMap;
Var
Z : INTEGER;
BEGIN
If CRTIsMono Then
BEGIN
CRTLoadMonoColorMap;
END { If CRTIsMono }
Else
BEGIN
For Z:=0 to 255 Do
CRTColorMap[ Z ] := Z;
END; { If CRTIsMono / Else }
END; { CRTLoadDefColorMap }
(*
Procedure MySend( Idata : POINTER; St : STRING ); Far;
Var
R : REGISTERS;
BEGIN
R.AH := $40;
R.BX := 1;
R.CX := Byte(ST[0] );;
R.DS := Seg( ST[1] );
R.DX := Ofs( ST[1] );
Intr( $21, R );
Write( tf, ST );
END;
*)
{────────────────────────────────────────────────────────────────────────────}
{────────────────────────────────────────────────────────────────────────────}
{────────────────────────────────────────────────────────────────────────────}
BEGIN
{$IFDEF DEBUG }
DebugOpen( 'VCRT.OUT' );
DebugWriteLn('Debug output started.');
DebugWriteLn('VCRT Unit Init Procedure:');
{$ENDIF}
{---------------------------------------}
{ Do the delay timing loop and load the }
{ default CRT colormap }
{---------------------------------------}
{$IFNDEF OS2}
FindDelay;
{$ENDIF}
CRTLoadDefColorMap;
{-----------}
{ Init vars }
{-----------}
CheckBreak := TRUE;
CheckEOF := FALSE;
{ get text attr somehow }
TextAttr := 1;
KnownTextAttr := TextAttr;
{$IFDEF DEBUG }
DebugWriteLn('VoutChannelNew');
{$ENDIF}
{----------------------------------}
{ Allocate the IN and OUT channels }
{----------------------------------}
CrtOCH := VOutChannelNew( 0, 'VCRT' );
{---------------------------------------}
{ create an output sub-channel attached }
{ to the CRT/Bx00 video memory }
{ output driver. }
{---------------------------------------}
{$IFNDEF OS2}
{$IFDEF DEBUG }
DebugWriteLn('VOutSubChannelNew( CRTOutProc )');
{$ENDIF}
VOutSubChannelNew( CrtOCH,
0,
'Bx00VMEM',
CRTOutDriverProc,
0, 0, 0 );
{$ELSE}
{$IFDEF DEBUG }
DebugWriteLn('VOutSubChannelNew( VIOOutDriverProc )');
{$ENDIF}
VOutSubChannelNew( CrtOCH,
0,
'Bx00VMEM',
VIOOutDriverProc,
0, 0, 0 );
{$ENDIF}
(*
VOutSubChannelNew( CrtOCH,
0,
'Bx00VMEM',
CrtOutDriverProc,
0, 0, 0 );
*)
(*
VOutSubChannelNew( CrtOCH,
0,
'Bx00VMEM',
ANSIOutDriverProc,
0,0,0 );
VOutFilterAttach( CrtOCH,
0,
'VACKY!',
'Bx00VMEM',
VirtScreenFilter,
0, 0, 0 );
*)
{$IFDEF DEBUG }
DebugWriteLn('VInDriverNew');
{$ENDIF}
VInDriverNew( CRTInDriverProc,
'VCRTInDP',
NIL,
CRTODNErr );
{$IFDEF DEBUG }
DebugWriteLn('VOutGetScreenSize');
{$ENDIF}
VOutGetScreenSize( CrtOCH, ScreenRows, ScreenCols );
(*
ScreenCols := 80;
ScreenRows := 25;
*)
WindMin := 0;
WindMax := ((ScreenRows-1) SHL 8) + ScreenCols-1;
{-------------------------}
{ Assign INPUT and OUTPUT }
{-------------------------}
AssignCRT( Input );
Reset ( Input );
AssignCRT( Output );
Rewrite ( Output );
END.
(*
Output driver types:
OutDirect output direct to video memory
OutBios output to BIOS int 10h
OutDosAnsi output to DOS / use ANSI commands
OutDosAvatar output to DOS / use AVATAR commands
OutTPcrt output through Turbo Pascals CRT unit
OutOPcrt output through Object Professionals OpCRT unit
OutSerAnsi output to Serial Channel / Use ANSI commands
OutSerAvatar output to Serial Channel / Use Avatar commands
OutSerVioPro output to Serial Channel / Use Visionix I/O Protocol
Input driver types:
InDirect Input direct from keyboard
InBios Input from BIOS
InTPcrt Input from TPCRT
inOPcrt Input from Object pro CRT
InDos Input from DOS
InSer Input from serial port
Avatar
^V ^A
^B
^C
^D
*)